home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / hugs101.zip / hugs101sc.zip / hugsdist / src / storage.h < prev    next >
C/C++ Source or Header  |  1995-03-02  |  22KB  |  541 lines
  1. /* --------------------------------------------------------------------------
  2.  * storage.h:   Copyright (c) Mark P Jones 1991-1994.   All rights reserved.
  3.  *              See NOTICE for details and conditions of use etc...
  4.  *              Hugs version 1.0 August 1994, derived from Gofer 2.30a
  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         Dict;             /* dictionary values       */
  35. typedef Cell         Triple;             /* triple of cell values  */
  36. typedef Cell         List;             /* list of cells       */
  37. typedef Cell         Bignum;             /* bignum integer       */
  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()  (heapFst)
  100. extern  Int          heapSize;
  101. extern  Heap         heapFst, heapSnd;
  102. #ifdef  GLOBALfst
  103. register Heap         heapTopFst GLOBALfst;
  104. #else
  105. extern   Heap          heapTopFst;
  106. #endif
  107. #ifdef  GLOBALsnd
  108. register Heap         heapTopSnd GLOBALsnd;
  109. #else
  110. extern   Heap          heapTopSnd;
  111. #endif
  112. #define fst(c)         heapTopFst[c]
  113. #define snd(c)         heapTopSnd[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. extern  Void         garbageCollect  Args((Void));
  120.  
  121. #define mark(v)      v=markExpr(v)
  122.  
  123. #define isPair(c)    ((c)<0)
  124. #define isGenPair(c) (-heapSize<=(c) && (c)<0)
  125.  
  126. extern    Cell         whatIs    Args((Cell));
  127.  
  128. /* --------------------------------------------------------------------------
  129.  * Box cell tags are used as the fst element of a pair to indicate that
  130.  * the snd element of the pair is to be treated in some special way, other
  131.  * than as a Cell.  Examples include holding integer values, variable name
  132.  * and string text etc.
  133.  * ------------------------------------------------------------------------*/
  134.  
  135. #define TAGMIN         1          /* Box and constructor cell tag values   */
  136. #define BCSTAG         20       /* Box=TAGMIN..BCSTAG-1           */
  137. #define isTag(c)     (TAGMIN<=(c) && (c)<SPECMIN) /* Tag cell values       */
  138. #define isBoxTag(c)  (TAGMIN<=(c) && (c)<BCSTAG)  /* Box cell tag values   */
  139. #define isConTag(c)  (BCSTAG<=(c) && (c)<SPECMIN) /* Constr cell tag values*/
  140.  
  141. #define INDIRECT     1          /* Indirection node:          snd :: Cell  */
  142. #define INDIRECT1    2          /* Temporary indirection:   snd :: Cell  */
  143. #define VARIDCELL    3          /* Identifier variable:     snd :: Text  */
  144. #define VAROPCELL    4          /* Operator variable:       snd :: Text  */
  145. #define DICTVAR         5          /* Dictionary variable:     snd :: Text  */
  146. #define CONIDCELL    6          /* Identifier constructor:  snd :: Text  */
  147. #define CONOPCELL    7          /* Operator constructor:    snd :: Text  */
  148. #define STRCELL      8          /* String literal:          snd :: Text  */
  149. #define INTCELL         9          /* Integer literal:          snd :: Int   */
  150. #if NPLUSK
  151. #define ADDPAT         10          /* (_+k) pattern discr:     snd :: Int   */
  152. #endif
  153. #define DICTCELL     12          /* Dictionary value:        snd :: Dict  */
  154. #define FILECELL     13          /* Input file number:       snd :: Int   */
  155. #if !BREAK_FLOATS
  156. #define FLOATCELL    14          /* Floating pt number:      snd :: Float */
  157. #endif
  158.  
  159. #define textOf(c)    ((Text)(snd(c)))
  160. #define intValOf(c)    (snd(c))
  161. #define mkVar(t)    ap(VARIDCELL,t)
  162. #define mkVarop(t)    ap(VAROPCELL,t)
  163. #define inventVar()    mkVar(inventText())
  164. #define mkDictVar(t)    ap(DICTVAR,t)
  165. #define inventDictVar() mkDictVar(inventDictText())
  166. #define mkStr(t)    ap(STRCELL,t)
  167. extern    Bool        isVar     Args((Cell));
  168. extern    Bool        isCon     Args((Cell));
  169. extern  Cell        openFile  Args((String));
  170. extern  Void        evalFile  Args((Cell));
  171.  
  172. #define isFloat(c)      (isPair(c) && fst(c)==FLOATCELL)
  173. extern    Cell        mkFloat        Args((FloatPro));
  174. extern  FloatPro    floatOf        Args((Cell));
  175. extern  String        floatToString   Args((FloatPro));
  176. extern  FloatPro    stringToFloat   Args((String));
  177. #if BREAK_FLOATS
  178. extern  Cell        part1Float    Args((FloatPro));
  179. extern  Cell        part2Float    Args((FloatPro));
  180. extern  FloatPro    floatFromParts    Args((Cell,Cell));
  181. #endif
  182.  
  183. /* --------------------------------------------------------------------------
  184.  * Constructor cell tags are used as the fst element of a pair to indicate
  185.  * a particular syntactic construct described by the snd element of the
  186.  * pair.
  187.  * Note that a cell c will not be treated as an application (AP/isAp) node
  188.  * if its first element is a constructor cell tag, whereas a cell whose fst
  189.  * element is a special cell will be treated as an application node.
  190.  * ------------------------------------------------------------------------*/
  191.  
  192. #define LETREC         20       /* LETREC    snd :: ([Decl],Exp)       */
  193. #define COND         21       /* COND    snd :: (Exp,Exp,Exp)       */
  194. #define LAMBDA         22       /* LAMBDA    snd :: Alt           */
  195. #define FINLIST      23       /* FINLIST    snd :: [Exp]           */
  196. #define COMP         25       /* COMP    snd :: (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 NUMCASE         30          /* NUMCASE    snd :: (Exp,[Alt])       */
  201. #define FATBAR         31       /* FATBAR    snd :: (Exp,Exp)       */
  202. #define LAZYPAT      32       /* LAZYPAT    snd :: Exp           */
  203. #define QUAL         33       /* QUAL       snd :: ([Classes],Type)    */
  204. #define RUNST         34          /* RUNST    snd :: Exp           */
  205. #define DERIVE         35          /* DERIVE    snd :: Cell           */
  206. #if BREAK_FLOATS
  207. #define FLOATCELL    36          /* FLOATCELL  snd :: (Int,Int)       */
  208. #endif
  209.  
  210. #define POSNUM         37          /* POSNUM    snd :: [Int]           */
  211. #define NEGNUM         38          /* NEGNUM    snd :: [Int]           */
  212.  
  213. #define BOOLQUAL     39       /* BOOLQUAL    snd :: Exp           */
  214. #define QWHERE         40       /* QWHERE    snd :: [Decl]           */
  215. #define FROMQUAL     41       /* FROMQUAL    snd :: (Exp,Exp)       */
  216.  
  217. #define GUARDED      42       /* GUARDED    snd :: [guarded exprs]       */
  218.  
  219. #define ARRAY        45          /* Array:     snd :: (Bounds,[Values])   */
  220. #define MUTVAR         46          /* Mutvar:    snd :: Cell           */
  221.  
  222. #define POLYTYPE     48          /* POLYTYPE    snd :: (Kind,Type)       */
  223.  
  224. /* --------------------------------------------------------------------------
  225.  * Special cell values:
  226.  * ------------------------------------------------------------------------*/
  227.  
  228. #define SPECMIN      101
  229. #define isSpec(c)    (SPECMIN<=(c) && (c)<TUPMIN)/* Special cell values    */
  230.  
  231. #define UNIT         101      /* Unit type/value denoted ()        */
  232. #define STAR         102      /* Representing the kind of types       */
  233. #define LIST         103      /* Builtin list type constructor       */
  234. #define ARROW         104      /* Builtin function space constructor    */
  235. #define WILDCARD     105      /* Wildcard pattern               */
  236.  
  237. #define ZERONUM      107      /* The zero bignum (see POSNUM, NEGNUM)  */
  238.  
  239. #define NAME         110      /* whatIs code for isName           */
  240. #define TYCON         111      /* whatIs code for isTycon           */
  241. #define CLASS         112      /* whatIs code for isClass           */
  242. #define SELECT       113          /* whatIs code for isSelect              */
  243. #define INSTANCE     114          /* whatIs code for isInst                */
  244. #define TUPLE         115      /* whatIs code for tuple constructor       */
  245. #define OFFSET         116      /* whatis code for offset           */
  246. #define AP         117      /* whatIs code for application node       */
  247. #define CHARCELL     118      /* whatIs code for isChar           */
  248.  
  249. #define SIGDECL      120      /* Signature declaration           */
  250. #define CFUN         121      /* Indicates name acting as constr fun   */
  251. #define MFUN         122      /* Indicates name acting as member fun   */
  252. #define UNDEFINED    123      /* indicates name with syntax but no defn*/
  253. #define PREDEFINED   124      /* predefined name, not yet filled       */
  254. #define NEEDED       125      /* marks name as needed supercombinator  */
  255.  
  256. #define DATATYPE     130      /* datatype type constructor           */
  257. #define SYNONYM         131      /* synonym type constructor           */
  258. #define RESTRICTSYN  132      /* synonym with restricted scope       */
  259.  
  260. #define NODEPENDS    135      /* stop calculation of deps in type check*/
  261.  
  262. #define fn(from,to)  pair(pair(ARROW,from),to)     /* make type:    from -> to */
  263.  
  264. /* --------------------------------------------------------------------------
  265.  * Tuple data/type constructors:
  266.  * ------------------------------------------------------------------------*/
  267.  
  268. #define TUPMIN         201
  269. #define isTuple(c)   (TUPMIN<=(c) && (c)<OFFMIN)
  270. #define mkTuple(n)   (TUPMIN+(n))
  271. #define tupleOf(n)   ((Int)((n)-TUPMIN))
  272.  
  273. /* --------------------------------------------------------------------------
  274.  * Offsets: (generic types/stack offsets)
  275.  * ------------------------------------------------------------------------*/
  276.  
  277. #define OFFMIN         (TUPMIN+NUM_TUPLES)
  278. #define isOffset(c)  (OFFMIN<=(c) && (c)<TYCMIN)
  279. #define offsetOf(c)  ((c)-OFFMIN)
  280. #define mkOffset(o)  (OFFMIN+(o))
  281.  
  282. /* --------------------------------------------------------------------------
  283.  * Type constructor names:
  284.  * ------------------------------------------------------------------------*/
  285.  
  286. #define TYCMIN         (OFFMIN+NUM_OFFSETS)
  287. #define isTycon(c)   (TYCMIN<=(c) && (c)<NAMEMIN)
  288. #define mkTycon(n)   (TCMIN+(n))
  289. #define tycon(n)     tabTycon[(n)-TYCMIN]
  290.  
  291. struct Tycon {
  292.     Text  text;
  293.     Int   line;
  294.     Int   arity;
  295.     Kind  kind;                /* kind (includes arity) of Tycon  */
  296.     Cell  what;                /* DATATYPE/SYNONYM/RESTRICTSYN... */
  297.     Cell  defn;
  298.     Tycon nextTyconHash;
  299. };
  300.  
  301. extern struct Tycon tabTycon[];
  302.  
  303. extern Tycon newTycon      Args((Text));
  304. extern Tycon findTycon      Args((Text));
  305. extern Tycon addPrimTycon Args((String,Kind,Int,Cell,Cell));
  306.  
  307. #define isSynonym(h)    (isTycon(h) && tycon(h).what==SYNONYM)
  308. #define mkPolyType(n,t)    pair(POLYTYPE,pair(n,t))
  309. #define isPolyType(t)    (isPair(t) && fst(t)==POLYTYPE)
  310. #define polySigOf(t)    fst(snd(t))
  311. #define monoTypeOf(t)    snd(snd(t))
  312.  
  313. /* --------------------------------------------------------------------------
  314.  * Globally defined name values:
  315.  * ------------------------------------------------------------------------*/
  316.  
  317. #define NAMEMIN      (TYCMIN+NUM_TYCON)
  318. #define isName(c)    (NAMEMIN<=(c) && (c)<SELMIN)
  319. #define mkName(n)    (NAMEMIN+(n))
  320. #define name(n)      tabName[(n)-NAMEMIN]
  321.  
  322. struct Name {
  323.     Text text;
  324.     Int  line;
  325.     Int  arity;
  326.     Int  number;     /* UNDEFINED : line number of first use           */
  327.              /* CFUN      : constructor number (e.g. Nil=0,Cons=1) */
  328.              /* MFUN      : member number (offset into Dict!)       */
  329.     Cell type;
  330.     Cell defn;
  331.     Addr code;
  332.     Prim primDef;
  333.     Name nextNameHash;
  334. };
  335.  
  336. extern struct Name tabName[];
  337.  
  338. extern Name newName     Args((Text));
  339. extern Name findName     Args((Text));
  340. extern Void addPrim     Args((Int,Name,String,Type));
  341. extern Name addPrimCfun  Args((String,Int,Int,Cell));
  342.  
  343. /* --------------------------------------------------------------------------
  344.  * Type class values:
  345.  * ------------------------------------------------------------------------*/
  346.  
  347. #define SELMIN       (NAMEMIN+NUM_NAME)          /* dictionary selectors   */
  348. #define isSelect(c)  (SELMIN<=(c) && (c)<INSTMIN)
  349. #define mkSelect(n)  (SELMIN+(n))
  350. #define selectOf(c)  ((Int)((c)-SELMIN))
  351.  
  352. #define INSTMIN      (SELMIN+NUM_SELECTS)        /* instances              */
  353. #define isInst(c)    (INSTMIN<=(c) && (c)<CLASSMIN)
  354. #define mkInst(n)    (INSTMIN+(n))
  355. #define inst(in)     tabInst[(in)-INSTMIN]
  356.  
  357. struct Inst {
  358.     Class c;                /* class C               */
  359.     Cell  t;                /* type  T               */
  360.     Int   arity;            /* number of args           */
  361.     Int   line;
  362.     List  specifics;            /* :: [Pred]               */
  363.     Int   numSpecifics;            /* length(specifics)           */
  364.     List  implements;
  365.     List  dicts;            /* :: [Dict]               */
  366.     List  superBuild;            /* instructions for superclasses   */
  367. };
  368.  
  369. /* a predicate (an element :: Pred) is an application of a Class to one or
  370.  * more type expressions
  371.  */
  372.  
  373. #define CLASSMIN     (INSTMIN+NUM_INSTS)
  374. #define isClass(c)   (CLASSMIN<=(c) && (c)<CHARMIN)
  375. #define mkClass(n)   (CLASSMIN+(n))
  376. #define class(n)     tabClass[(n)-CLASSMIN]
  377.  
  378. struct Class {
  379.     Text text;                /* Name of class           */
  380.     Int  line;                /* Line where declaration begins   */
  381.     Int  level;                /* Level in class hierarchy       */
  382.     Kind sig;                /* Kind of constructors in class   */
  383.     List supers;            /* :: [Class] (immed superclasses) */
  384.     Int  numSupers;            /* length(supers)           */
  385.     List members;            /* :: [Name]               */
  386.     Int  numMembers;            /* length(members)           */
  387.     List defaults;            /* :: [Name]               */
  388.     List instances;            /* :: [Inst]               */
  389. };
  390.  
  391. extern struct Class    tabClass[];
  392. extern struct Inst far *tabInst;
  393. extern Cell       far *tabDict;
  394.  
  395. #define dict(at)       tabDict[at]
  396. #define dictOf(c)      ((Dict)(snd(c)))
  397. #define mkDict(d)      ap(DICTCELL,d)
  398.  
  399. extern Class newClass       Args((Text));
  400. extern Class findClass       Args((Text));
  401. extern Inst  newInst       Args((Void));
  402. extern Inst  findInst       Args((Class,Type));
  403. extern Inst  findFirstInst Args((Tycon));
  404. extern Inst  findNextInst  Args((Tycon,Inst));
  405. extern Cell  makeInstPred  Args((Inst));
  406. extern Dict  newDict       Args((Int));
  407.  
  408. /* --------------------------------------------------------------------------
  409.  * Character values:
  410.  * ------------------------------------------------------------------------*/
  411.  
  412. #define CHARMIN      (CLASSMIN+NUM_CLASSES)
  413. #define MAXCHARVAL   (NUM_CHARS-1)
  414. #define isChar(c)    (CHARMIN<=(c) && (c)<INTMIN)
  415. #define charOf(c)    ((Char)(c-CHARMIN))
  416. #define mkChar(c)    ((Cell)(CHARMIN+((unsigned)((c)%NUM_CHARS))))
  417.  
  418. /* --------------------------------------------------------------------------
  419.  * Small Integer values:
  420.  * ------------------------------------------------------------------------*/
  421.  
  422. #define INTMIN         (CHARMIN+NUM_CHARS)
  423. #define INTMAX         MAXPOSINT
  424. #define isSmall(c)   (INTMIN<=(c))
  425. #define INTZERO      (INTMIN/2 + INTMAX/2)
  426. #define mkDigit(c)   ((Cell)((c)+INTMIN))
  427. #define digitOf(c)   ((Int)((c)-INTMIN))
  428.  
  429. extern    Bool isInt    Args((Cell));
  430. extern    Int  intOf    Args((Cell));
  431. extern    Cell mkInt    Args((Int));
  432. extern  Bool isBignum Args((Cell));
  433.  
  434. /* --------------------------------------------------------------------------
  435.  * Implementation of triples:
  436.  * ------------------------------------------------------------------------*/
  437.  
  438. #define triple(x,y,z) pair(x,pair(y,z))
  439. #define fst3(c)      fst(c)
  440. #define snd3(c)      fst(snd(c))
  441. #define thd3(c)      snd(snd(c))
  442.  
  443. /* --------------------------------------------------------------------------
  444.  * Implementation of lists:
  445.  * ------------------------------------------------------------------------*/
  446.  
  447. #define NIL         0
  448. #define isNull(c)    ((c)==NIL)
  449. #define nonNull(c)   (c)
  450. #define cons(x,xs)   pair(x,xs)
  451. #define singleton(x) cons(x,NIL)
  452. #define hd(c)         fst(c)
  453. #define tl(c)         snd(c)
  454.  
  455. extern    Int         length      Args((List));
  456. extern    List         appendOnto   Args((List,List));
  457. extern  List         dupList      Args((List));
  458. extern    List         revOnto      Args((List, List));
  459. #define rev(xs)      revOnto((xs),NIL)
  460.  
  461. extern    Cell         cellIsMember Args((Cell,List));
  462. extern    Cell         varIsMember  Args((Text,List));
  463. extern  Cell         intIsMember  Args((Int,List));
  464. extern    List         copy      Args((Int,Cell));
  465. extern    List         diffList      Args((List,List));
  466. extern  List         take      Args((Int,List));
  467. extern  List         initSeg      Args((List));
  468. extern  List         removeCell      Args((Cell,List));
  469.  
  470. /* The following macros provide `inline expansion' of some common ways of
  471.  * traversing, using and modifying lists:
  472.  *
  473.  * N.B. We use the names _f, _a, _xs, Zs, in an attempt to avoid clashes
  474.  *    with identifiers used elsewhere.
  475.  */
  476.  
  477. #define mapBasic(_init,_step)      {List Zs=(_init);\
  478.                    for(;nonNull(Zs);Zs=tl(Zs))\
  479.                    _step;}
  480. #define mapModify(_init,_step)      mapBasic(_init,hd(Zs)=_step)
  481.  
  482. #define mapProc(_f,_xs)       mapBasic(_xs,_f(hd(Zs)))
  483. #define map1Proc(_f,_a,_xs)      mapBasic(_xs,_f(_a,hd(Zs)))
  484. #define map2Proc(_f,_a,_b,_xs)      mapBasic(_xs,_f(_a,_b,hd(Zs)))
  485. #define map3Proc(_f,_a,_b,_c,_xs) mapBasic(_xs,_f(_a,_b,_c,hd(Zs)))
  486.  
  487. #define mapOver(_f,_xs)       mapModify(_xs,_f(hd(Zs)))
  488. #define map1Over(_f,_a,_xs)      mapModify(_xs,_f(_a,hd(Zs)))
  489. #define map2Over(_f,_a,_b,_xs)      mapModify(_xs,_f(_a,_b,hd(Zs)))
  490. #define map3Over(_f,_a,_b,_c,_xs) mapModify(_xs,_f(_a,_b,_c,hd(Zs)))
  491.  
  492. /* --------------------------------------------------------------------------
  493.  * Implementation of function application nodes:
  494.  * ------------------------------------------------------------------------*/
  495.  
  496. #define ap(f,x)      pair(f,x)
  497. #define fun(c)         fst(c)
  498. #define arg(c)         snd(c)
  499. #define isAp(c)      (isPair(c) && !isTag(fst(c)))
  500. extern    Cell         getHead     Args((Cell));
  501. extern    List         getArgs     Args((Cell));
  502. extern    Int         argCount;
  503. extern  Cell         nthArg     Args((Int,Cell));
  504. extern  Int         numArgs     Args((Cell));
  505. extern  Cell         applyToArgs Args((Cell,List));
  506.  
  507. /* --------------------------------------------------------------------------
  508.  * Stack implementation:
  509.  * ------------------------------------------------------------------------*/
  510.  
  511. extern    Cell         cellStack[];
  512. #ifdef  GLOBALsp
  513. register StackPtr    sp GLOBALsp;
  514. #else
  515. extern    StackPtr     sp;
  516. #endif
  517. #define clearStack() sp=(-1)
  518. #define stackEmpty() (sp==(-1))
  519. #define stack(p)     cellStack[p]
  520. #define chkStack(n)  if (sp>=NUM_STACK-n) stackOverflow()
  521. #define push(c)      chkStack(1); onto(c)
  522. #define onto(c)         stack(++sp)=(c)
  523. #define pop()         stack(sp--)
  524. #define drop()         sp--
  525. #define top()         stack(sp)
  526. #define pushed(n)    stack(sp-(n))
  527.  
  528. extern Void         stackOverflow Args((Void));
  529.  
  530. /* --------------------------------------------------------------------------
  531.  * Module control:
  532.  * The implementation of `module' storage is hidden.
  533.  * ------------------------------------------------------------------------*/
  534.  
  535. extern Module       startNewModule  Args((Void));
  536. extern Bool        nameThisModule  Args((Name));
  537. extern Module       moduleThisName  Args((Name));
  538. extern Void       dropModulesFrom Args((Module));
  539.  
  540. /*-------------------------------------------------------------------------*/
  541.