home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / gofer / Sources / h / storage < prev   
Encoding:
Text File  |  1993-02-12  |  21.9 KB  |  569 lines
  1. /* --------------------------------------------------------------------------
  2.  * storage.h:   Copyright (c) Mark P Jones 1991-1993.   All rights reserved.
  3.  *              See goferite.h for details and conditions of use etc...
  4.  *              Gofer version 2.28 January 1993
  5.  *
  6.  * Defines storage datatypes: Text, Name, Module, Tycon, Cell, List, Pair,
  7.  * Triple, ...
  8.  * ------------------------------------------------------------------------*/
  9.  
  10. /* --------------------------------------------------------------------------
  11.  * Typedefs for main data types:
  12.  * Many of these type names are used to indicate the intended us of a data
  13.  * item, rather than for type checking purposes.  Sadly (although sometimes,
  14.  * fortunately), the C compiler cannot distinguish between the use of two
  15.  * different names defined to be synonyms for the same types.
  16.  * ------------------------------------------------------------------------*/
  17.  
  18. typedef Int         Text;             /* text string        */
  19. typedef Unsigned     Syntax;             /* syntax (assoc,preced)  */
  20. typedef Int         Addr;             /* address of code       */
  21. typedef Int         Cell;             /* general cell value       */
  22. typedef Cell far     *Heap;             /* storage of heap       */
  23. typedef Cell         Pair;             /* pair cell           */
  24. typedef Int         StackPtr;             /* stack pointer       */
  25. typedef Cell         Offset;             /* offset/generic variable*/
  26. typedef Cell         Tycon;             /* type constructor       */
  27. typedef Cell         Type;             /* type expression       */
  28. typedef Cell         Kind;             /* kind expression       */
  29. typedef Cell         Constr;             /* constructor expression */
  30. typedef Cell         Name;             /* named value        */
  31. typedef Void         (*Prim) Args((StackPtr));     /* primitive function       */
  32. typedef Cell         Class;             /* type class           */
  33. typedef Cell         Inst;             /* instance of type class */
  34. typedef Int         Idx;             /* dictionary index tree  */
  35. typedef Int         Dict;             /* dictionary values       */
  36. typedef Cell         Triple;             /* triple of cell values  */
  37. typedef Cell         List;             /* list of cells       */
  38. typedef Int         Module;             /* module number       */
  39. typedef FloatImpType Float;             /* implementation of Float*/
  40.  
  41. /* --------------------------------------------------------------------------
  42.  * Text storage:
  43.  * provides storage for the characters making up identifier and symbol
  44.  * names, string literals, character constants etc...
  45.  * ------------------------------------------------------------------------*/
  46.  
  47. extern    String         textToStr        Args((Text));
  48. extern    Text         findText        Args((String));
  49. extern    Text         inventText        Args((Void));
  50. extern  Text         inventDictText    Args((Void));
  51.  
  52. /* --------------------------------------------------------------------------
  53.  * Specification of syntax (i.e. default written form of application)
  54.  * ------------------------------------------------------------------------*/
  55.  
  56. #define MIN_PREC  0               /* weakest binding operator       */
  57. #define MAX_PREC  9               /* strongest binding operator       */
  58. #define FUN_PREC  (MAX_PREC+2)           /* binding of function symbols       */
  59. #define DEF_PREC  MAX_PREC
  60. #define APPLIC      00000            /* written applicatively        */
  61. #define LEFT_ASS  02000            /* left associative infix       */
  62. #define RIGHT_ASS 04000            /* right associative infix       */
  63. #define NON_ASS   06000            /* non associative infix        */
  64. #define DEF_ASS   NON_ASS
  65.  
  66. #define assocOf(x)    ((x)&NON_ASS)
  67. #define precOf(x)    ((x)&(~NON_ASS))
  68. #define mkSyntax(a,p)    ((a)|(p))
  69. #define DEF_OPSYNTAX    mkSyntax(DEF_ASS,DEF_PREC)
  70.  
  71. extern    Void   addSyntax  Args((Int,Text,Syntax));
  72. extern    Syntax syntaxOf   Args((Text));
  73.  
  74. /* --------------------------------------------------------------------------
  75.  * Primitive functions:
  76.  * ------------------------------------------------------------------------*/
  77.  
  78. extern struct primitive {        /* table of primitives           */
  79.     String ref;                /* primitive reference string       */
  80.     Int       arity;            /* primitive function arity       */
  81.     Prim   imp;                /* primitive implementation       */
  82. } primitives[];
  83.  
  84. #define PRIM_GOFC    ((Prim)1)    /* primitive implemented by gofc   */
  85. #define PRIM_NOGOFC    ((Prim)2)    /* or not, as the case may be ...  */
  86.  
  87. /* --------------------------------------------------------------------------
  88.  * Program code storage: for holding compiled function defns etc...
  89.  * ------------------------------------------------------------------------*/
  90.  
  91. extern    Addr         getMem Args((Int));
  92.  
  93. /* --------------------------------------------------------------------------
  94.  * Heap storage:
  95.  * Provides a garbage collectable heap for storage of expressions etc.
  96.  * ------------------------------------------------------------------------*/
  97.  
  98. #define heapAlloc(s) (Heap)(farCalloc(s,sizeof(Cell)))
  99. #define heapBuilt()  (heapCar)
  100. extern  Int          heapSize;
  101. extern  Heap         heapCar, heapCdr;
  102. #ifdef  GLOBALcar
  103. register Heap         heapTopCar GLOBALcar;
  104. #else
  105. extern   Heap          heapTopCar;
  106. #endif
  107. #ifdef  GLOBALcdr
  108. register Heap         heapTopCdr GLOBALcdr;
  109. #else
  110. extern   Heap          heapTopCdr;
  111. #endif
  112. #define fst(c)         heapTopCar[c]
  113. #define snd(c)         heapTopCdr[c]
  114.  
  115. extern    Pair         pair         Args((Cell,Cell));
  116. extern  Void         overwrite         Args((Pair,Pair));
  117. extern  Cell         markExpr         Args((Cell));
  118. extern  Void         markWithoutMove Args((Cell));
  119.  
  120. #define mark(v)      v=markExpr(v)
  121.  
  122. #define isPair(c)    ((c)<0)
  123. #define isGenPair(c) (-heapSize<=(c) && (c)<0)
  124.  
  125. extern    Cell         whatIs    Args((Cell));
  126.  
  127. /* --------------------------------------------------------------------------
  128.  * Box cell tags are used as the fst element of a pair to indicate that
  129.  * the snd element of the pair is to be treated in some special way, other
  130.  * than as a Cell.  Examples include holding integer values, variable name
  131.  * and string text etc.
  132.  * ------------------------------------------------------------------------*/
  133.  
  134. #define TAGMIN         1          /* Box and constructor cell tag values   */
  135. #define BCSTAG         20       /* Box=TAGMIN..BCSTAG-1           */
  136. #define isTag(c)     (TAGMIN<=(c) && (c)<SPECMIN) /* Tag cell values       */
  137. #define isBoxTag(c)  (TAGMIN<=(c) && (c)<BCSTAG)  /* Box cell tag values   */
  138. #define isConTag(c)  (BCSTAG<=(c) && (c)<SPECMIN) /* Constr cell tag values*/
  139.  
  140. #define INDIRECT     1          /* Indirection node:          snd :: Cell  */
  141. #define INDIRECT1    2          /* Temporary indirection:   snd :: Cell  */
  142. #define VARIDCELL    3          /* Identifier variable:     snd :: Text  */
  143. #define VAROPCELL    4          /* Operator variable:       snd :: Text  */
  144. #define DICTVAR         5          /* Dictionary variable:     snd :: Text  */
  145. #define CONIDCELL    6          /* Identifier constructor:  snd :: Text  */
  146. #define CONOPCELL    7          /* Operator constructor:    snd :: Text  */
  147. #define STRCELL      8          /* String literal:          snd :: Text  */
  148. #define INTCELL         9          /* Integer literal:          snd :: Int   */
  149. #define ADDPAT         10          /* (_+k) pattern discr:     snd :: Int   */
  150. #define MULPAT       11          /* (c*_) pattern discr:     snd :: Int   */
  151. #define DICTCELL     12          /* Dictionary value:        snd :: Dict  */
  152. #define FILECELL     13          /* Input file number:       snd :: Int   */
  153. #if !BREAK_FLOATS
  154. #define FLOATCELL    14          /* Floating pt number:      snd :: Float */
  155. #endif
  156.  
  157. #define textOf(c)    ((Text)(snd(c)))
  158. #define intValOf(c)    (snd(c))
  159. #define mkVar(t)    ap(VARIDCELL,t)
  160. #define mkVarop(t)    ap(VAROPCELL,t)
  161. #define inventVar()    mkVar(inventText())
  162. #define mkDictVar(t)    ap(DICTVAR,t)
  163. #define inventDictVar() mkDictVar(inventDictText())
  164. #define mkStr(t)    ap(STRCELL,t)
  165. extern    Bool        isVar     Args((Cell));
  166. extern    Bool        isCon     Args((Cell));
  167. extern  Cell        openFile  Args((String));
  168. extern  Void        evalFile  Args((Cell));
  169.  
  170. #define isFloat(c)      (isPair(c) && fst(c)==FLOATCELL)
  171. extern    Cell        mkFloat        Args((FloatPro));
  172. extern  FloatPro    floatOf        Args((Cell));
  173. extern  String        floatToString   Args((FloatPro));
  174. extern  FloatPro    stringToFloat   Args((String));
  175. #if BREAK_FLOATS
  176. extern  Cell        part1Float    Args((FloatPro));
  177. extern  Cell        part2Float    Args((FloatPro));
  178. extern  FloatPro    floatFromParts    Args((Cell,Cell));
  179. #endif
  180.  
  181. /* --------------------------------------------------------------------------
  182.  * Constructor cell tags are used as the fst element of a pair to indicate
  183.  * a particular syntactic construct described by the snd element of the
  184.  * pair.
  185.  * Note that a cell c will not be treated as an application (AP/isAp) node
  186.  * if its first element is a constructor cell tag, whereas a cell whose fst
  187.  * element is a special cell will be treated as an application node.
  188.  * ------------------------------------------------------------------------*/
  189.  
  190. #define LETREC         20       /* LETREC    snd :: ([Decl],Exp)       */
  191. #define COND         21       /* COND    snd :: (Exp,Exp,Exp)       */
  192. #define LAMBDA         22       /* LAMBDA    snd :: Alt           */
  193. #define FINLIST      23       /* FINLIST    snd :: [Exp]           */
  194. #define COMP         24          /* COMP    snd :: (Exp,[Qual])       */
  195. #define LISTCOMP     25       /* LISCOMP    snd :: (Exp,[Qual])       */
  196. #define MONADCOMP    26          /* MONADCOMP  snd :: (dicts,(Exp,[Qual]))*/
  197. #define ASPAT         27       /* ASPAT    snd :: (Var,Exp)       */
  198. #define ESIGN         28       /* ESIGN    snd :: (Exp,Type)       */
  199. #define CASE         29       /* CASE    snd :: (Exp,[Alt])       */
  200. #define FATBAR         30       /* FATBAR    snd :: (Exp,Exp)       */
  201. #define LAZYPAT      31       /* LAZYPAT    snd :: Exp           */
  202. #define QUAL         32       /* QUAL       snd :: ([Classes],Type)    */
  203. #if BREAK_FLOATS
  204. #define FLOATCELL    33          /* FLOATCELL  snd :: (Int,Int)       */
  205. #endif
  206.  
  207. #define BOOLQUAL     36       /* BOOLQUAL    snd :: Exp           */
  208. #define QWHERE         37       /* QWHERE    snd :: [Decl]           */
  209. #define FROMQUAL     38       /* FROMQUAL    snd :: (Exp,Exp)       */
  210.  
  211. #define GUARDED      39       /* GUARDED    snd :: [guarded exprs]       */
  212.  
  213. #define POLYTYPE     45          /* POLYTYPE    snd :: (Kind,Type)       */
  214.  
  215. #define C_TOPARG     50          /* Compiler instruction codes:       */
  216. #define C_TOPFUN     51          /* see cmachine.c for further details       */
  217. #define C_SETSTK     52
  218. #define C_EVAL         53
  219. #define C_LABEL      54
  220. #define C_GOTO         55
  221. #define C_FLUSH         56
  222. #define C_UPDAP2     57
  223. #define C_HEAP         58
  224.  
  225. #define C_PUSHPAIR   60
  226. #define C_UPDATE     61
  227. #define C_SLIDE         62
  228. #define C_INTEQ         63
  229. #define C_TEST         64
  230.  
  231. #define C_UPDAP         70
  232. #define C_INTGE      71
  233. #define C_INTDV      72
  234.  
  235. #define BRANCH         80           /* Code generator continuation structures*/
  236. #define FBRANCH         81          /* see cmachine.c for further details    */
  237.  
  238. /* --------------------------------------------------------------------------
  239.  * Special cell values:
  240.  * ------------------------------------------------------------------------*/
  241.  
  242. #define SPECMIN      101
  243. #define isSpec(c)    (SPECMIN<=(c) && (c)<TUPMIN)/* Special cell values    */
  244.  
  245. #define UNIT         101      /* Unit type/value denoted ()        */
  246. #define STAR         102      /* Representing the kind of types       */
  247. #define LIST         103      /* Builtin list type constructor       */
  248. #define ARROW         104      /* Builtin function space constructor    */
  249. #define WILDCARD     105      /* Wildcard pattern               */
  250.  
  251. #define NAME         110      /* whatIs code for isName           */
  252. #define TYCON         111      /* whatIs code for isTycon           */
  253. #define CLASS         112      /* whatIs code for isClass           */
  254. #define SELECT       113          /* whatIs code for isSelect              */
  255. #define INSTANCE     114          /* whatIs code for isInst                */
  256. #define TUPLE         115      /* whatIs code for tuple constructor       */
  257. #define OFFSET         116      /* whatis code for offset           */
  258. #define AP         117      /* whatIs code for application node       */
  259. #define CHARCELL     118      /* whatIs code for isChar           */
  260.  
  261. #define SIGDECL      120      /* Signature declaration           */
  262. #define CFUN         121      /* Indicates name acting as constr fun   */
  263. #define MFUN         122      /* Indicates name acting as member fun   */
  264. #define PRIM         123      /* indicates name defined by primitive   */
  265. #define UNDEFINED    124      /* indicates name with syntax but no defn*/
  266. #define PREDEFINED   125      /* predefined name, not yet filled       */
  267. #define NEEDED       126      /* marks name as needed supercombinator  */
  268.  
  269. #define DATATYPE     130      /* datatype type constructor           */
  270. #define SYNONYM         131      /* synonym type constructor           */
  271. #define RESTRICTSYN  132      /* synonym with restricted scope       */
  272.  
  273. #define NODEPENDS    135      /* stop calculation of deps in type check*/
  274.  
  275. #define TOP         140      /* refers to top of stack in cmachine.c  */
  276. #define POP         141      /* like TOP above, but remove from stack */
  277.  
  278. #define ROOTFST         145      /* represents func to move down from root*/
  279.  
  280. #define C_MKAP         150          /* Compiler instruction codes:       */
  281. #define C_ALLOC         151      /* see cmachine.c for further details       */
  282. #define C_RETURN     152
  283.  
  284. #define ERRCONT         160      /* Code generator continuation structures*/
  285. #define RUNONC         161      /* see cmachine.c for further details    */
  286. #define FRUNONC         162
  287. #define UPDRETC         163
  288.  
  289. #define fn(from,to)  pair(pair(ARROW,from),to)     /* make type:    from -> to */
  290.  
  291. /* --------------------------------------------------------------------------
  292.  * Tuple data/type constructors:
  293.  * ------------------------------------------------------------------------*/
  294.  
  295. #define TUPMIN         201
  296. #define isTuple(c)   (TUPMIN<=(c) && (c)<OFFMIN)
  297. #define mkTuple(n)   (TUPMIN+(n))
  298. #define tupleOf(n)   ((Int)((n)-TUPMIN))
  299.  
  300. /* --------------------------------------------------------------------------
  301.  * Offsets: (generic types/stack offsets)
  302.  * ------------------------------------------------------------------------*/
  303.  
  304. #define OFFMIN         (TUPMIN+NUM_TUPLES)
  305. #define isOffset(c)  (OFFMIN<=(c) && (c)<TYCMIN)
  306. #define offsetOf(c)  ((c)-OFFMIN)
  307. #define mkOffset(o)  (OFFMIN+(o))
  308.  
  309. /* --------------------------------------------------------------------------
  310.  * Type constructor names:
  311.  * ------------------------------------------------------------------------*/
  312.  
  313. #define TYCMIN         (OFFMIN+NUM_OFFSETS)
  314. #define isTycon(c)   (TYCMIN<=(c) && (c)<NAMEMIN)
  315. #define mkTycon(n)   (TCMIN+(n))
  316. #define tycon(n)     tabTycon[(n)-TYCMIN]
  317.  
  318. struct Tycon {
  319.     Text  text;
  320.     Int   line;
  321.     Int   arity;
  322.     Kind  kind;                /* kind (includes arity) of Tycon  */
  323.     Cell  what;                /* DATATYPE/SYNONYM/RESTRICTSYN... */
  324.     Cell  defn;
  325.     Tycon nextTyconHash;
  326. };
  327.  
  328. extern struct Tycon tabTycon[];
  329.  
  330. extern Tycon newTycon      Args((Text));
  331. extern Tycon findTycon      Args((Text));
  332. extern Tycon addPrimTycon Args((String,Kind,Cell,Cell));
  333.  
  334. #define isSynonym(h)    (isTycon(h) && tycon(h).what==SYNONYM)
  335. #define mkPolyType(n,t)    pair(POLYTYPE,pair(n,t))
  336. #define isPolyType(t)    (isPair(t) && fst(t)==POLYTYPE)
  337. #define polySigOf(t)    fst(snd(t))
  338. #define monoTypeOf(t)    snd(snd(t))
  339.  
  340. /* --------------------------------------------------------------------------
  341.  * Globally defined name values:
  342.  * ------------------------------------------------------------------------*/
  343.  
  344. #define NAMEMIN      (TYCMIN+NUM_TYCON)
  345. #define isName(c)    (NAMEMIN<=(c) && (c)<SELMIN)
  346. #define mkName(n)    (NAMEMIN+(n))
  347. #define name(n)      tabName[(n)-NAMEMIN]
  348.  
  349. struct Name {
  350.     Text text;
  351.     Int  line;
  352.     Int  arity;
  353.     Int  number;     /* UNDEFINED : line number of first use           */
  354.              /* CFUN      : constructor number (e.g. Nil=0,Cons=1) */
  355.              /* MFUN      : member number (offset into Dict!)       */
  356.     Cell type;
  357.     Cell defn;
  358.     Addr code;
  359.     Prim primDef;
  360.     Name nextNameHash;
  361. };
  362.  
  363. extern struct Name tabName[];
  364.  
  365. extern Name newName    Args((Text));
  366. extern Name findName    Args((Text));
  367. extern Void addPrim    Args((Int,Name,String,Type));
  368. extern Name addPrimCfun Args((String,Int,Int,Cell));
  369.  
  370. /* --------------------------------------------------------------------------
  371.  * Type class values:
  372.  * ------------------------------------------------------------------------*/
  373.  
  374. #define SELMIN       (NAMEMIN+NUM_NAME)          /* dictionary selectors   */
  375. #define isSelect(c)  (SELMIN<=(c) && (c)<INSTMIN)
  376. #define mkSelect(n)  (SELMIN+(n))
  377. #define selectOf(c)  ((Int)((c)-SELMIN))
  378.  
  379. #define INSTMIN      (SELMIN+NUM_SELECTS)        /* instances              */
  380. #define isInst(c)    (INSTMIN<=(c) && (c)<CLASSMIN)
  381. #define mkInst(n)    (INSTMIN+(n))
  382. #define inst(in)     tabInst[(in)-INSTMIN]
  383.  
  384. struct Inst {
  385.     Class cl;
  386.     Int   line;
  387.     Kind  sig;                /* kinds of variables in header       */
  388.     Cell  head;                /* :: Pred               */
  389.     List  specifics;            /* :: [Pred]               */
  390.     Int   numSpecifics;            /* length(specifics)           */
  391.     List  implements;
  392. };
  393.  
  394. /* a predicate (an element :: Pred) is an application of a Class to one or
  395.  * more type expressions
  396.  */
  397.  
  398. #define CLASSMIN     (INSTMIN+NUM_INSTS)
  399. #define isClass(c)   (CLASSMIN<=(c) && (c)<CHARMIN)
  400. #define mkClass(n)   (CLASSMIN+(n))
  401. #define class(n)     tabClass[(n)-CLASSMIN]
  402.  
  403. struct Class {
  404.     Text text;                /* Name of class           */
  405.     Int  line;
  406.     Int  arity;
  407.     Kind sig;                /* Sig ::= NIL | (Kind,Sig)       */
  408.     Cell head;                /* :: Pred               */
  409.     List supers;            /* :: [Pred]               */
  410.     Int  numSupers;            /* length(supers)           */
  411.     List members;            /* :: [Name]               */
  412.     Int  numMembers;            /* length(members)           */
  413.     List defaults;            /* :: [Name]               */
  414.     List instances;            /* :: [Inst]               */
  415.     Idx  dictIndex;
  416. };
  417.  
  418. struct Idx {
  419.     Cell test;
  420.     Idx  fail;
  421.     Idx  match;      /* may also be used as a Dict value ... */
  422. };
  423. #define NOIDX         ((Idx)(-1))
  424. #define NODICT         ((Dict)(-1))
  425.  
  426. extern struct Class    tabClass[];
  427. extern struct Inst far *tabInst;
  428. extern struct Idx  far *tabIndex;
  429. extern Cell       far *tabDict;
  430.  
  431. #define idx(ix)        tabIndex[ix]
  432. #define dict(at)       tabDict[at]
  433. #define dictOf(c)      ((Dict)(snd(c)))
  434. #define mkDict(d)      ap(DICTCELL,d)
  435.  
  436. extern Class newClass  Args((Text));
  437. extern Class findClass Args((Text));
  438. extern Inst  newInst   Args((Void));
  439. extern Idx   newIdx    Args((Cell));
  440. extern Dict  newDict   Args((Int));
  441.  
  442. /* --------------------------------------------------------------------------
  443.  * Character values:
  444.  * ------------------------------------------------------------------------*/
  445.  
  446. #define CHARMIN      (CLASSMIN+NUM_CLASSES)
  447. #define MAXCHARVAL   (NUM_CHARS-1)
  448. #define isChar(c)    (CHARMIN<=(c) && (c)<INTMIN)
  449. #define charOf(c)    ((Char)(c-CHARMIN))
  450. #define mkChar(c)    ((Cell)(CHARMIN+((unsigned)((c)%NUM_CHARS))))
  451.  
  452. /* --------------------------------------------------------------------------
  453.  * Small Integer values:
  454.  * ------------------------------------------------------------------------*/
  455.  
  456. #define INTMIN         (CHARMIN+NUM_CHARS)
  457. #define INTMAX         MAXPOSINT
  458. #define isSmall(c)   (INTMIN<=(c))
  459. #define INTZERO      (INTMIN/2 + INTMAX/2)
  460.  
  461. extern    Bool isInt   Args((Cell));
  462. extern    Int  intOf   Args((Cell));
  463. extern    Cell mkInt   Args((Int));
  464.  
  465. /* --------------------------------------------------------------------------
  466.  * Implementation of triples:
  467.  * ------------------------------------------------------------------------*/
  468.  
  469. #define triple(x,y,z) pair(x,pair(y,z))
  470. #define fst3(c)      fst(c)
  471. #define snd3(c)      fst(snd(c))
  472. #define thd3(c)      snd(snd(c))
  473.  
  474. /* --------------------------------------------------------------------------
  475.  * Implementation of lists:
  476.  * ------------------------------------------------------------------------*/
  477.  
  478. #define NIL         0
  479. #define isNull(c)    ((c)==NIL)
  480. #define nonNull(c)   (c)
  481. #define cons(x,xs)   pair(x,xs)
  482. #define singleton(x) cons(x,NIL)
  483. #define hd(c)         fst(c)
  484. #define tl(c)         snd(c)
  485.  
  486. extern    Int         length      Args((List));
  487. extern    List         appendOnto   Args((List,List));
  488. extern    List         revOnto      Args((List, List));
  489. #define rev(xs)      revOnto((xs),NIL)
  490.  
  491. extern    Cell         cellIsMember Args((Cell,List));
  492. extern    Cell         varIsMember  Args((Text,List));
  493. extern    List         copy      Args((Int,Cell));
  494. extern    List         diffList      Args((List,List));
  495. extern  List         take      Args((Int,List));
  496. extern  List         removeCell      Args((Cell,List));
  497.  
  498. /* The following macros provide `inline expansion' of some common ways of
  499.  * traversing, using and modifying lists:
  500.  *
  501.  * N.B. We use the names _f, _a, _xs, Zs, in an attempt to avoid clashes
  502.  *    with identifiers used elsewhere.
  503.  */
  504.  
  505. #define mapBasic(_init,_step)      {List Zs=(_init);\
  506.                    for(;nonNull(Zs);Zs=tl(Zs))\
  507.                    _step;}
  508. #define mapModify(_init,_step)      mapBasic(_init,hd(Zs)=_step)
  509.  
  510. #define mapProc(_f,_xs)       mapBasic(_xs,_f(hd(Zs)))
  511. #define map1Proc(_f,_a,_xs)      mapBasic(_xs,_f(_a,hd(Zs)))
  512. #define map2Proc(_f,_a,_b,_xs)      mapBasic(_xs,_f(_a,_b,hd(Zs)))
  513. #define map3Proc(_f,_a,_b,_c,_xs) mapBasic(_xs,_f(_a,_b,_c,hd(Zs)))
  514.  
  515. #define mapOver(_f,_xs)       mapModify(_xs,_f(hd(Zs)))
  516. #define map1Over(_f,_a,_xs)      mapModify(_xs,_f(_a,hd(Zs)))
  517. #define map2Over(_f,_a,_b,_xs)      mapModify(_xs,_f(_a,_b,hd(Zs)))
  518. #define map3Over(_f,_a,_b,_c,_xs) mapModify(_xs,_f(_a,_b,_c,hd(Zs)))
  519.  
  520. /* --------------------------------------------------------------------------
  521.  * Implementation of function application nodes:
  522.  * ------------------------------------------------------------------------*/
  523.  
  524. #define ap(f,x)      pair(f,x)
  525. #define fun(c)         fst(c)
  526. #define arg(c)         snd(c)
  527. #define isAp(c)      (isPair(c) && !isTag(fst(c)))
  528. extern    Cell         getHead     Args((Cell));
  529. extern    List         getArgs     Args((Cell));
  530. extern    Int         argCount;
  531. extern  Cell         nthArg     Args((Int,Cell));
  532. extern  Int         numArgs     Args((Cell));
  533. extern  Cell         applyToArgs Args((Cell,List));
  534.  
  535. /* --------------------------------------------------------------------------
  536.  * Stack implementation:
  537.  * ------------------------------------------------------------------------*/
  538.  
  539. extern    Cell         cellStack[];
  540. #ifdef  GLOBALsp
  541. register StackPtr    sp GLOBALsp;
  542. #else
  543. extern    StackPtr     sp;
  544. #endif
  545. #define clearStack() sp=(-1)
  546. #define stackEmpty() (sp==(-1))
  547. #define stack(p)     cellStack[p]
  548. #define chkStack(n)  if (sp>=NUM_STACK-n) stackOverflow()
  549. #define push(c)      chkStack(1); onto(c)
  550. #define onto(c)         stack(++sp)=(c)
  551. #define pop()         stack(sp--)
  552. #define drop()         sp--
  553. #define top()         stack(sp)
  554. #define pushed(n)    stack(sp-(n))
  555.  
  556. extern Void         stackOverflow Args((Void));
  557.  
  558. /* --------------------------------------------------------------------------
  559.  * Module control:
  560.  * The implementation of `module' storage is hidden.
  561.  * ------------------------------------------------------------------------*/
  562.  
  563. extern Module       startNewModule  Args((Void));
  564. extern Bool        nameThisModule  Args((Name));
  565. extern Module       moduleThisName  Args((Name));
  566. extern Void       dropModulesFrom Args((Module));
  567.  
  568. /*-------------------------------------------------------------------------*/
  569.