mim/development/mim/vax/mimlib/abstr-defs.mud

   1 <DEFINITIONS "ABSTR-DEFS">
   2
   3 <USE "NEWSTRUC" "SORTX" "ABSTR">
   4
   5 ;"*** Object Definitions. ***"
   6
   7 ;"A DU (Description Unit) models a package - created during using/loading.
   8   The same structure is used to model definition modules: the distinction
   9   between packages and definition modules is the presence or absence of
  10   the internal oblist in the DU, respectively."
  11
  12 <NEWSTRUC DU VECTOR
  13           DU-NAME STRING                    ;"Name of package."
  14           DU-OBL OBLIST                     ;"Entry oblist."
  15           DU-IOBL <OR OBLIST FALSE>         ;"Internal oblist."
  16           DU-ENTRIES <LIST [REST ATOM]>     ;"Entrys."
  17           DU-RENTRIES <LIST [REST ATOM]>    ;"Rentrys."
  18           DU-USES <LIST [REST DU]>          ;"Packages used."
  19           DU-EXPORTS <LIST [REST DU]>       ;"Packages exported."
  20           DU-INCLUDES <LIST [REST DU]>      ;"Definitions included."
  21           DU-SPECIAL <LIST [REST FORM]>     ;"Special forms."
  22           DU-MARKED <OR ATOM FALSE>>        ;"If du is used by toplevel du."
  23
  24 ;"Macros for un/marking DUs."
  25
  26 <DEFMAC DU-MARKED? ('DU) <FORM DU-MARKED .DU>>
  27
  28 <DEFMAC MARK-DU ('DU) <FORM DU-MARKED .DU T>>
  29
  30 <DEFMAC UNMARK-DU ('DU) <FORM DU-MARKED .DU %<>>>
  31
  32 ;"An ABSTRACTION is used for accumulating forms that will appear in abstract.
  33   It is a vector of four queues, one for each of the four kinds of forms that
  34   appear in an abstract: SETG, NEWTYPE and PUT-DECL, MANIFEST, GDECL."
  35
  36 <NEWSTRUC ABSTRACTION VECTOR
  37           A-GVALS <LIST ATOM [REST FORM]>   ;"SETG forms."
  38           A-GTAIL <LIST ANY>                ;"Tail of above."
  39           A-TYPES <LIST ATOM [REST FORM]>   ;"NEWTYPE, PUT-DECL forms."
  40           A-TTAIL <LIST ANY>                ;"Tail of above."
  41           A-CONST <LIST [REST ATOM]>        ;"MANIFEST atoms."
  42           A-DECLS LIST>                     ;"Body of GDECL form."
  43
  44 ;"NEW-ABSTRACTION - Return an empty abstraction."
  45
  46 <DEFMAC NEW-ABSTRACTION ()
  47    ;"The atoms TYPES, GVALS are handles for PUTREST (enqueueing)."
  48    '<BIND ((GVALS (GVAL)) (TYPES (TYPE)))
  49        #DECL ((GVALS TYPES) <LIST ATOM>)
  50        <CHTYPE [.GVALS .GVALS .TYPES .TYPES () ()] ABSTRACTION>>>
  51
  52 ;"ENQ-GVAL - Append <SETG ATOM GVAL> to gvals queue of ABSTRACTION."
  53
  54 <DEFMAC ENQ-GVAL ('ABSTRACTION 'ATOM 'GVAL)
  55    <FORM BIND ((A .ABSTRACTION) (TAIL (<FORM CHTYPE (SETG .ATOM .GVAL) FORM>)))
  56          '#DECL ((A) ABSTRACTION (TAIL) <LIST FORM>)
  57          '<PUTREST <A-GTAIL .A> .TAIL>
  58          '<A-GTAIL .A .TAIL>>>
  59 \f
  60 ;"ENQ-TYPE - Append PUT-DECL, NEWTYPE, NEW-CHANNEL-TYPE FORM to types
  61   queue of ABSTRACTION."
  62
  63 <DEFMAC ENQ-TYPE ('ABSTRACTION 'FORM)
  64    <FORM BIND ((A .ABSTRACTION) (TAIL (.FORM)))
  65          '#DECL ((A) ABSTRACTION (TAIL) <LIST FORM>)
  66          '<PUTREST <A-TTAIL .A> .TAIL>
  67          '<A-TTAIL .A .TAIL>>>
  68
  69 ;"ENQ-CONST - Add ATOM to const (MANIFEST) list of ABSTRACTION."
  70
  71 <DEFMAC ENQ-CONST ('ABSTRACTION 'ATOM)
  72    <FORM BIND ((A .ABSTRACTION))
  73          '#DECL ((A) ABSTRACTION)
  74          <FORM A-CONST '.A (.ATOM '!<A-CONST .A>)>>>
  75
  76 ;"ENQ-DECL - Add decl D for N to decls (GDECL) list of ABSTRACTION."
  77
  78 <DEFMAC ENQ-DECL ('A 'N 'D)
  79    ;"If there is a decl = D in decls, add N to the list.
  80      Else, append a decl pair to decls."
  81    <FORM BIND ((AA .A) (NN .N) (DD .D) '(DECLS <A-DECLS .AA>))
  82          '#DECL ((AA) ABSTRACTION (NN) ATOM (DD) <OR ATOM SEGMENT>
  83                  (DECLS) LIST)
  84          '<COND (<EMPTY? .DECLS>
  85                  <A-DECLS .AA ((.NN) .DD)>)
  86                 (T
  87                  <REPEAT (RDECLS)
  88                     #DECL ((RDECLS) LIST)
  89                     <COND (<=? <1 <SET RDECLS <REST .DECLS>>> .DD>
  90                            <PUT .DECLS 1 (.NN !<1 .DECLS>)>
  91                            <RETURN>)
  92                           (<EMPTY? <SET DECLS <REST .RDECLS>>>
  93                            <PUTREST .RDECLS ((.NN) .DD)>
  94                            <RETURN>)>>)>>>
  95
  96 ;"BLURB - Concatenate and print several strings to OUTCHAN if ABSTRACT-NOISY?."
  97
  98 <DEFMAC BLURB ("ARGS" BLURB)
  99    <FORM COND (',ABSTRACT-NOISY?
 100                '<CRLF>
 101                <FORM PRINTSTRING <FORM STRING !.BLURB>>)>>
 102
 103 ;"SORTA, SORTS - Sort vectors of atoms and strings"
 104
 105 <DEFMAC SORTA ('V)
 106    <FORM BIND ((VV .V))
 107          '#DECL ((VV) VECTOR)
 108          '<COND (<EMPTY? .VV> .VV) (T <SORT ,ALESS? .VV> .VV)>>>
 109
 110 <DEFMAC SORTS ('V)
 111    <FORM BIND ((VV .V))
 112        '#DECL ((VV) VECTOR)
 113        '<COND (<EMPTY? .VV> .VV) (T <SORT %<> .VV> .VV)>>>
 114
 115 ;"EXTRACT-NM1 - Get the first name from a file spec."
 116
 117 <DEFMAC EXTRACT-NM1 ('STRING)
 118    <FORM BIND ((CH <FORM CHANNEL-OPEN PARSE .STRING>)
 119                '(NAME1 <CHANNEL-OP .CH NM1>))
 120          '#DECL ((CH) <CHANNEL 'PARSE> (NAME1) STRING)
 121          '<CHANNEL-CLOSE .CH>
 122          '.NAME1>>
 123 \f
 124 ;"*** Definitions which depend on implementation of MDL environment. ***"
 125
 126 <UNMANIFEST OLD-TYPES>
 127
 128 <GDECL (OLD-TYPES) FIX (ATOM-TABLE) VECTOR> ;"External."
 129
 130 ;"NEWTYPE-ATOM? - Return false if TYPE-NAME is not the name of a new type."
 131
 132 <DEFMAC NEWTYPE-ATOM? ('ATOM)
 133    <FORM AND <FORM VALID-TYPE? .ATOM>
 134              <FORM G? <FORM LSH <FORM TYPE-C .ATOM> -6> ',OLD-TYPES>>>
 135
 136 ;"NEWTYPE-OBJECT - Return false if type of OBJECT is not a new type."
 137
 138 <DEFMAC NEWTYPE-OBJECT? ('OBJECT)
 139    <FORM G? <FORM LSH <FORM TYPE-C <FORM TYPE .OBJECT>> -6> ',OLD-TYPES>>
 140
 141 ;"Offsets for extracting interesting things from msubrs and macros."
 142
 143 <MSETG IMSUBR-NAME <OFFSET 1 '<PRIMTYPE VECTOR>>>
 144
 145 <MSETG MSUBR-NAME <OFFSET 2 '<PRIMTYPE VECTOR>>>
 146
 147 <MSETG MSUBR-ARG-DECL <OFFSET 3 '<PRIMTYPE VECTOR>>>
 148
 149 <MSETG IMSUBR-OFFSET <OFFSET 4 '<PRIMTYPE VECTOR>>>
 150
 151 <MSETG MACRO-BODY <OFFSET 1 '<PRIMTYPE LIST>>>
 152
 153 ;"MSUBR-IMVECTOR - Return the mvector of the imsubr associated with MSUBR."
 154
 155 <DEFMAC MSUBR-IMVECTOR ('MSUBR)
 156    <FORM REST <FORM 1 <FORM GVAL <FORM IMSUBR-NAME .MSUBR>>>>>
 157
 158 ;"MSUBR-IMSUBR - Return the imsubr associated with MSUBR."
 159
 160 <DEFMAC MSUBR-IMSUBR ('MSUBR) <FORM GVAL <FORM IMSUBR-NAME .MSUBR>>>
 161
 162 <END-DEFINITIONS>