[project @ 2000-03-22 18:14:22 by sewardj]
[ghc-hetmet.git] / ghc / interpreter / storage.h
1
2 /* --------------------------------------------------------------------------
3  * Defines storage datatypes: Text, Name, Module, Tycon, Cell, List, Pair,
4  * Triple, ...
5  *
6  * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
7  * Yale Haskell Group, and the Oregon Graduate Institute of Science and
8  * Technology, 1994-1999, All rights reserved.  It is distributed as
9  * free software under the license in the file "License", which is
10  * included in the distribution.
11  *
12  * $RCSfile: storage.h,v $
13  * $Revision: 1.35 $
14  * $Date: 2000/03/22 18:14:23 $
15  * ------------------------------------------------------------------------*/
16
17 #define DEBUG_STORAGE
18
19 /* --------------------------------------------------------------------------
20  * Typedefs for main data types:
21  * Many of these type names are used to indicate the intended us of a data
22  * item, rather than for type checking purposes.  Sadly (although sometimes,
23  * fortunately), the C compiler cannot distinguish between the use of two
24  * different names defined to be synonyms for the same types.
25  * ------------------------------------------------------------------------*/
26
27 typedef Int          Text;                       /* text string            */
28 typedef Unsigned     Syntax;                     /* syntax (assoc,preced)  */
29 typedef Int          Cell;                       /* general cell value     */
30 typedef Cell far     *Heap;                      /* storage of heap        */
31 typedef Cell         Pair;                       /* pair cell              */
32 typedef Int          StackPtr;                   /* stack pointer          */
33 typedef Cell         Offset;                     /* offset/generic variable*/
34 typedef Int          Module;                     /* module                 */
35 typedef Cell         Tycon;                      /* type constructor       */
36 typedef Cell         Type;                       /* type expression        */
37 typedef Cell         Kind;                       /* kind expression        */
38 typedef Cell         Kinds;                      /* list of kinds          */
39 typedef Cell         Constr;                     /* constructor expression */
40 typedef Cell         Name;                       /* named value            */
41 typedef Cell         Class;                      /* type class             */
42 typedef Cell         Inst;                       /* instance of type class */
43 typedef Cell         Triple;                     /* triple of cell values  */
44 typedef Cell         List;                       /* list of cells          */
45 typedef Cell         Bignum;                     /* bignum integer         */
46 typedef Cell         Float;                      /* floating pt literal    */
47 #if TREX
48 typedef Cell         Ext;                        /* extension label        */
49 #endif
50
51 typedef Cell         ConId;
52 typedef Cell         VarId;
53 typedef Cell         QualId;
54 typedef Cell         ConVarId;
55
56 /* --------------------------------------------------------------------------
57  * Address ranges.
58  * 
59  * -heapSize .. -1                                    cells in the heap
60  * 0                                                  NIL
61  *
62  * TAG_NONPTR_MIN(100) .. TAG_NONPTR_MAX(115)         non pointer tags
63  * TAG_PTR_MIN(200)    .. TAG_PTR_MAX(298)            pointer tags
64  * TAG_SPEC_MIN(400)   .. TAG_SPEC_MAX(425)           special tags
65  * OFF_MIN(1,000)      .. OFF_MAX(1,999)              offsets
66  * CHAR_MIN(3,000)     .. CHAR_MAX(3,255)             chars
67  *
68  * SMALL_INT_MIN(100,000) .. SMALL_INT_MAX(499,999)   smallish ints
69  *              (300,000 denotes 0)
70  *
71  * NAME_BASE_ADDR   (1,000,000 .. 1,899,999)          names
72  * TYCON_BASE_ADDR  (2,000,000 .. 2,899,999)          tycons
73  * CCLASS_BASE_ADDR (3,000,000 .. 3,899,999)          classes
74  * INST_BASE_ADDR   (4,000,000 .. 4,899,999)          instances
75  * MODULE_BASE_ADDR (5,000,000 .. 5,899,999)          modules
76  * INVAR_BASE_ADDR  (6,000,000 .. 6,899,999)          invented var names
77  * INDVAR_BASE_ADDR (7,000,000 .. 7,899,999)          invented dict var names
78  * TEXT_BASE_ADDR   (8,000,000 .. 8M +TEXT_SIZE-1)    text
79  * ------------------------------------------------------------------------*/
80
81 /* --------------------------------------------------------------------------
82  * Text storage:
83  * provides storage for the characters making up identifier and symbol
84  * names, string literals, character constants etc...
85  * ------------------------------------------------------------------------*/
86
87 extern  String       textToStr            ( Text );
88 extern  Text         findText             ( String );
89 extern  Text         inventText           ( Void );
90 extern  Text         inventDictText       ( Void );
91 extern  Bool         inventedText         ( Text );
92 extern  Text         enZcodeThenFindText  ( String );
93 extern  Text         unZcodeThenFindText  ( String );
94
95 /* Variants of textToStr and syntaxOf which work for idents, ops whether
96  * qualified or unqualified.
97  */
98 extern  String       identToStr         ( Cell );
99 extern  Text         fixLitText         ( Text );
100 extern  Syntax       identSyntax        ( Cell );
101 extern  Syntax       defaultSyntax      ( Text );
102
103 #define INVAR_BASE_ADDR  6000000
104 #define INVAR_MAX_AVAIL  900000
105 #define isInventedVar(c) (INVAR_BASE_ADDR<=(c) \
106                           && (c)<INVAR_BASE_ADDR+INVAR_MAX_AVAIL)
107
108 #define INDVAR_BASE_ADDR 7000000
109 #define INDVAR_MAX_AVAIL 900000
110 #define isInventedDictVar(c) (INDVAR_BASE_ADDR<=(c) \
111                               && (c)<INDVAR_BASE_ADDR+INDVAR_MAX_AVAIL)
112
113 #define TEXT_BASE_ADDR   8000000
114 #define isText(c) (TEXT_BASE_ADDR<=(c) \
115                   && (c)<TEXT_BASE_ADDR+TEXT_SIZE)
116
117 /* --------------------------------------------------------------------------
118  * Specification of syntax (i.e. default written form of application)
119  * ------------------------------------------------------------------------*/
120
121 #define MIN_PREC  0                    /* weakest binding operator         */
122 #define MAX_PREC  9                    /* strongest binding operator       */
123 #define FUN_PREC  (MAX_PREC+2)         /* binding of function symbols      */
124 #define DEF_PREC  MAX_PREC
125 #define APPLIC    0                    /* written applicatively            */
126 #define LEFT_ASS  1                    /* left associative infix           */
127 #define RIGHT_ASS 2                    /* right associative infix          */
128 #define NON_ASS   3                    /* non associative infix            */
129 #define DEF_ASS   LEFT_ASS
130
131 #define UMINUS_PREC  6                  /* Change these settings at your   */
132 #define UMINUS_ASSOC LEFT_ASS           /* own risk; they may not work!    */
133
134 #define assocOf(x)      ((x)&NON_ASS)
135 #define precOf(x)       ((x)>>2)
136 #define mkSyntax(a,p)   ((a)|((p)<<2))
137 #define DEF_OPSYNTAX    mkSyntax(DEF_ASS,DEF_PREC)
138 #define NO_SYNTAX       (-1)
139
140 extern  Void   addSyntax  ( Int,Text,Syntax );
141 extern  Syntax syntaxOf   ( Text );
142
143 /* --------------------------------------------------------------------------
144  * Heap storage:
145  * Provides a garbage collectable heap for storage of expressions etc.
146  * ------------------------------------------------------------------------*/
147
148 #define heapAlloc(s) (Heap)(farCalloc(s,sizeof(Cell)))
149 #define heapBuilt()  (heapFst)
150 extern  Int          heapSize;
151 extern  Heap         heapFst, heapSnd;
152 extern  Heap         heapTopFst;
153 extern  Heap         heapTopSnd;
154 extern  Bool         consGC;            /* Set to FALSE to turn off gc from*/
155                                         /* C stack; use with extreme care! */
156 extern  Int          cellsRecovered;    /* cells recovered by last gc      */
157
158 #define fst(c)       heapTopFst[c]
159 #define snd(c)       heapTopSnd[c]
160
161 extern  Pair         pair            ( Cell,Cell );
162 extern  Void         garbageCollect  ( Void );
163
164 extern  Void         overwrite       ( Pair,Pair );
165 extern  Cell         markExpr        ( Cell );
166 extern  Void         markWithoutMove ( Cell );
167
168 #define mark(v)      v=markExpr(v)
169
170 #define isPair(c)    ((c)<0)
171 #define isGenPair(c) ((c)<0 && -heapSize<=(c))
172
173 extern  Cell         whatIs    ( Cell );
174
175 /* --------------------------------------------------------------------------
176  * Pairs in the heap fall into three categories.
177  *
178  * pair(TAG_NONPTR,y)
179  *    used to denote that the second element of the pair is to be treated
180  *    in some special way (eg is a integer or Text), and specifically is not
181  *    a heap pointer
182  * 
183  * pair(TAG_PTR,y)
184  *    to indicate that the second element of the pair is a normal 
185  *    heap pointer, which should be followed at GC time
186  * 
187  * pair(x,y)
188  *    is a genuine pair, where both components are heap pointers.
189  * ------------------------------------------------------------------------*/
190
191 #if !defined(SIZEOF_VOID_P) || !defined(SIZEOF_INT)
192 #error SIZEOF_VOID_P or SIZEOF_INT is not defined
193 #endif
194
195 #define isTagNonPtr(c) (TAG_NONPTR_MIN<=(c) && (c)<=TAG_NONPTR_MAX)
196 #define isTagPtr(c)    (TAG_PTR_MIN<=(c) && (c)<=TAG_PTR_MAX)
197 #define isTag(c)       (isTagNonPtr(c) || isTagPtr(c))
198
199 /* --------------------------------------------------------------------------
200  * Tags for non-pointer cells.
201  * ------------------------------------------------------------------------*/
202
203 #define TAG_NONPTR_MIN 100
204 #define TAG_NONPTR_MAX 115
205
206 #define FREECELL     100          /* Free list cell:          snd :: Cell  */
207 #define VARIDCELL    101          /* Identifier variable:     snd :: Text  */
208 #define VAROPCELL    102          /* Operator variable:       snd :: Text  */
209 #define DICTVAR      103          /* Dictionary variable:     snd :: Text  */
210 #define CONIDCELL    104          /* Identifier constructor:  snd :: Text  */
211 #define CONOPCELL    105          /* Operator constructor:    snd :: Text  */
212 #define STRCELL      106          /* String literal:          snd :: Text  */
213 #define INTCELL      107          /* Int literal:             snd :: Int   */
214 #define ADDPAT       108          /* (_+k) pattern discr:     snd :: Int   */
215 #define FLOATCELL    109          /* Floating Pt literal:     snd :: Text  */
216 #define BIGCELL      110          /* Integer literal:         snd :: Text  */
217 #define PTRCELL      111          /* C Heap Pointer           snd :: Ptr   */
218 #define CPTRCELL     112          /* Native code pointer      snd :: Ptr   */
219
220 #if IPARAM
221 #define IPCELL       113          /* Imp Param Cell:          snd :: Text  */
222 #define IPVAR        114          /* ?x:                      snd :: Text  */
223 #endif
224
225 #if TREX
226 #define EXTCOPY      115          /* Copy of an Ext:          snd :: Text  */
227 #endif
228
229 #define qmodOf(c)       (textOf(fst(snd(c))))    /* c ::  QUALIDENT        */
230 #define qtextOf(c)      (textOf(snd(snd(c))))    /* c ::  QUALIDENT        */
231 #define mkVar(t)        ap(VARIDCELL,t)
232 #define mkVarop(t)      ap(VAROPCELL,t)
233 #define mkCon(t)        ap(CONIDCELL,t)
234 #define mkConop(t)      ap(CONOPCELL,t)
235 #define mkQVar(m,t)     ap(QUALIDENT,pair(mkCon(m),mkVar(t)))
236 #define mkQCon(m,t)     ap(QUALIDENT,pair(mkCon(m),mkCon(t)))
237 #define mkQVarOp(m,t)   ap(QUALIDENT,pair(mkCon(m),mkVarop(t)))
238 #define mkQConOp(m,t)   ap(QUALIDENT,pair(mkCon(m),mkConop(t)))
239 #define mkQualId(m,t)   ap(QUALIDENT,pair(m,t))
240 #define intValOf(c)     (snd(c))
241 #define inventVar()     mkVar(inventText())
242 #define mkDictVar(t)    ap(DICTVAR,t)
243 #define inventDictVar() mkDictVar(inventDictText())
244 #define mkStr(t)        ap(STRCELL,t)
245 #if IPARAM
246 #define mkIParam(c)     ap(IPCELL,snd(c))
247 #define isIP(p)         (whatIs(p) == IPCELL)
248 #define ipMatch(pi, t)  (isIP(fun(pi)) && textOf(fun(pi)) == t)
249 #define ipVar(pi)       textOf(fun(pi))
250 #else
251 #define isIP(p)         FALSE
252 #endif
253
254 extern  Bool            isVar        ( Cell );
255 extern  Bool            isCon        ( Cell );
256 extern  Bool            isQVar       ( Cell );
257 extern  Bool            isQCon       ( Cell );
258 extern  Bool            isQualIdent  ( Cell );
259 extern  Bool            eqQualIdent  ( QualId c1, QualId c2 );
260 extern  Bool            isIdent      ( Cell );
261 extern  String          stringNegate ( String );
262 extern  Text            textOf       ( Cell );
263
264 #define isFloat(c)       (isPair(c) && fst(c)==FLOATCELL)
265 #define stringToFloat(s) pair(FLOATCELL,findText(s))
266 #define floatToString(f) textToStr(snd(f))
267 #define floatOf(f)       atof(floatToString(f))
268 #define mkFloat(f)       (f)  /* ToDo: is this right? */
269 #define floatNegate(f)   stringToFloat(stringNegate(floatToString(f)))
270
271 #define stringToBignum(s) pair(BIGCELL,findText(s))
272 #define bignumToString(b) textToStr(snd(b))
273
274 #define isPtr(c)        (isPair(c) && fst(c)==PTRCELL)
275 extern  Cell            mkPtr           ( Ptr );
276 extern  Ptr             ptrOf           ( Cell );
277 #define isCPtr(c)       (isPair(c) && fst(c)==CPTRCELL)
278 extern  Cell            mkCPtr          ( Ptr );
279 extern  Ptr             cptrOf          ( Cell );
280
281 /* --------------------------------------------------------------------------
282  * Tags for pointer cells.
283  * ------------------------------------------------------------------------*/
284
285 #define TAG_PTR_MIN 200
286 #define TAG_PTR_MAX 298
287
288 #define LETREC       200          /* LETREC     snd :: ([Decl],Exp)        */
289 #define COND         201          /* COND       snd :: (Exp,Exp,Exp)       */
290 #define LAMBDA       202          /* LAMBDA     snd :: Alt                 */
291 #define FINLIST      203          /* FINLIST    snd :: [Exp]               */
292 #define DOCOMP       204          /* DOCOMP     snd :: (Exp,[Qual])        */
293 #define BANG         205          /* BANG       snd :: Type                */
294 #define COMP         206          /* COMP       snd :: (Exp,[Qual])        */
295 #define ASPAT        207          /* ASPAT      snd :: (Var,Exp)           */
296 #define ESIGN        208          /* ESIGN      snd :: (Exp,Type)          */
297 #define RSIGN        209          /* RSIGN      snd :: (Rhs,Type)          */
298 #define CASE         210          /* CASE       snd :: (Exp,[Alt])         */
299 #define NUMCASE      211          /* NUMCASE    snd :: (Exp,Disc,Rhs)      */
300 #define FATBAR       212          /* FATBAR     snd :: (Exp,Exp)           */
301 #define LAZYPAT      213          /* LAZYPAT    snd :: Exp                 */
302 #define DERIVE       214          /* DERIVE     snd :: Cell                */
303 #define BOOLQUAL     215          /* BOOLQUAL   snd :: Exp                 */
304 #define QWHERE       216          /* QWHERE     snd :: [Decl]              */
305 #define FROMQUAL     217          /* FROMQUAL   snd :: (Exp,Exp)           */
306 #define DOQUAL       218          /* DOQUAL     snd :: Exp                 */
307 #define MONADCOMP    219          /* MONADCOMP  snd :: ((m,m0),(Exp,[Qual])*/
308 #define GUARDED      220          /* GUARDED    snd :: [guarded exprs]     */
309 #define ARRAY        221          /* Array      snd :: (Bounds,[Values])   */
310 #define MUTVAR       222          /* Mutvar     snd :: Cell                */
311 #define HUGSOBJECT   223          /* HUGSOBJECT snd :: Cell                */
312
313 #if IPARAM
314 #define WITHEXP      224          /* WITHEXP    snd :: [(Var,Exp)]         */
315 #endif
316
317 #define POLYTYPE     225          /* POLYTYPE   snd :: (Kind,Type)         */
318 #define QUAL         226          /* QUAL       snd :: ([Classes],Type)    */
319 #define RANK2        227          /* RANK2      snd :: (Int,Type)          */
320 #define EXIST        228          /* EXIST      snd :: (Int,Type)          */
321 #define POLYREC      229          /* POLYREC    snd :: (Int,Type)          */
322 #define BIGLAM       230          /* BIGLAM     snd :: (vars,patterns)     */
323 #define CDICTS       231          /* CDICTS     snd :: ([Pred],Type)       */
324
325 #define LABC         232          /* LABC       snd :: (con,[(Vars,Type)]) */
326 #define CONFLDS      233          /* CONFLDS    snd :: (con,[Field])       */
327 #define UPDFLDS      234          /* UPDFLDS    snd :: (Exp,[con],[Field]) */
328 #if TREX
329 #define RECORD       235          /* RECORD     snd :: [Val]               */
330 #define EXTCASE      236          /* EXTCASE    snd :: (Exp,Disc,Rhs)      */
331 #define RECSEL       237          /* RECSEL     snd :: Ext                 */
332 #endif
333 #define IMPDEPS      238          /* IMPDEPS    snd :: [Binding]           */
334
335 #define QUALIDENT    239          /* Qualified identifier  snd :: (Id,Id)  */
336 #define HIDDEN       240          /* hiding import list    snd :: [Entity] */
337 #define MODULEENT    241          /* module in export list snd :: con      */
338
339 #define INFIX        242          /* INFIX      snd :: (see tidyInfix)     */
340 #define ONLY         243          /* ONLY       snd :: Exp                 */
341 #define NEG          244          /* NEG        snd :: Exp                 */
342
343 /* Used when parsing GHC interface files */
344 #define DICTAP       245          /* DICTAP     snd :: (QClassId,[Type])   */
345 #define UNBOXEDTUP   246          /* UNBOXEDTUP snd :: [Type]              */
346
347 #if SIZEOF_VOID_P != SIZEOF_INT
348 #define PTRCELL      247          /* C Heap Pointer snd :: (Int,Int)       */
349 #endif
350
351 /* STG syntax */
352 #define STGVAR       248          /* STGVAR     snd :: (StgRhs,info)       */
353 #define STGAPP       249          /* STGAPP     snd :: (StgVar,[Arg])      */
354 #define STGPRIM      250          /* STGPRIM    snd :: (PrimOp,[Arg])      */
355 #define STGCON       251          /* STGCON     snd :: (StgCon,[Arg])      */
356 #define PRIMCASE     252          /* PRIMCASE   snd :: (Expr,[PrimAlt])    */
357 #define DEEFALT      253          /* DEEFALT    snd :: (Var,Expr)          */
358 #define CASEALT      254          /* CASEALT    snd :: (Con,[Var],Expr)    */
359 #define PRIMALT      255          /* PRIMALT    snd :: ([Var],Expr)        */
360
361 /* Module groups */
362 #define GRP_REC      256          /* GRP_REC    snd :: [CONID]             */
363 #define GRP_NONREC   257          /* GRP_NONREC snd :: CONID               */
364
365
366 /* 
367    Top-level interface entities 
368    type Line             = Int  -- a line number 
369    type ConVarId         = CONIDCELL | VARIDCELL
370    type ExportListEntry  = ConVarId | (ConId, [ConVarId]) 
371    type Associativity    = mkInt of LEFT_ASS | RIGHT_ASS | NON_ASS
372    type Constr           = ((ConId, [((Type,VarId,Int))]))
373                ((constr name, [((type, field name if any, strictness))]))
374                strictness: 0 => none, 1 => !, 2 => !! (unpacked)
375    All 2/3/4/5 tuples in the interface abstract syntax are done with
376    z-tuples.
377 */
378
379 #define I_INTERFACE  260  /* snd :: ((ConId, [I_IMPORT..I_VALUE])) 
380                                     interface name, list of iface entities */
381
382 #define I_IMPORT     261  /* snd :: ((ConId, [ConVarId]))
383                                     module name, list of entities          */
384
385 #define I_INSTIMPORT 262  /* snd :: NIL    -- not used at present          */
386
387 #define I_EXPORT     263  /* snd :: ((ConId, [ExportListEntry]))
388                                     this module name?, entities to export  */
389
390 #define I_FIXDECL    264  /* snd :: ((NIL|Int, Associativity, ConVarId))   
391                                     fixity, associativity, name            */
392
393 #define I_INSTANCE   265 /* snd :: ((Line, 
394                                      [((VarId,Kind))], 
395                                      Type, VarId, Inst))
396                    lineno, 
397                    forall-y bit (eg __forall [a b] =>),
398                    other bit, eg { C a1 } -> { C2 a2 } -> ... -> { Cn an },
399                    name of dictionary builder,
400                    (after startGHCInstance) the instance table location    */
401
402 #define I_TYPE       266 /* snd :: ((Line, ConId, [((VarId,Kind))], Type))
403                             lineno, tycon, kinded tyvars, the type expr    */
404
405 #define I_DATA       267 /* snd :: ((Line, [((QConId,VarId))], ConId, 
406                                           [((VarId,Kind))], [Constr]) 
407                             lineno, context, tycon, kinded tyvars, constrs 
408                            An empty constr list means exported abstractly. */
409
410 #define I_NEWTYPE    268 /* snd :: ((Line, [((QConId,VarId))], ConId,
411                                     [((VarId,Kind))], ((ConId,Type)) ))
412                              lineno, context, tycon, kinded tyvars, constr 
413                                     constr==NIL means exported abstractly. */
414
415 #define I_CLASS      269 /* snd :: ((Line, [((QConId,VarId))], ConId,
416                                     [((VarId,Kind))], [((VarId,Type))]))
417                             lineno, context, classname, 
418                                       kinded tyvars, method sigs           */
419
420 #define I_VALUE      270 /* snd :: ((Line, VarId, Type))                   */
421
422 /*
423    Top-level module entities.
424
425    type Export = ?
426 */
427 #define M_MODULE     280 /* snd :: ((ConId, [Export], 
428                                      M_IMPORT_Q .. M_VALUE]))
429                             module name, export spec, top level entities   */
430
431 #define M_IMPORT_Q   281 /* snd :: ((?,?)) */
432 #define M_IMPORT_UNQ 282 /* snd :: ((?,?)) */
433 #define M_TYCON      283 /* snd :: ((Line,?,?,?)) */
434 #define M_CLASS      284 /* snd :: ((Line,?,?,?)) */
435 #define M_INST       285 /* snd :: ((Line,?,?)) */
436 #define M_DEFAULT    286 /* snd :: ((Line,?)) */
437 #define M_FOREIGN_EX 289 /* snd :: ((Line,?,?,?,?)) */
438 #define M_FOREIGN_IM 290 /* snd :: ((Line,?,?,?,?)) */
439 #define M_VALUE      291 /* snd :: ? */
440
441
442
443
444 /* 
445    Tagged tuples.
446 */
447 #define ZTUP2        295          /* snd :: (Cell,Cell)                    */
448 #define ZTUP3        296          /* snd :: (Cell,(Cell,Cell))             */
449 #define ZTUP4        297          /* snd :: (Cell,(Cell,(Cell,Cell)))      */
450 #define ZTUP5        298       /* snd :: (Cell,(Cell,(Cell,(Cell,Cell))))  */
451
452
453
454 /* --------------------------------------------------------------------------
455  * Special cell values.
456  * ------------------------------------------------------------------------*/
457
458 #define TAG_SPEC_MIN 400
459 #define TAG_SPEC_MAX 428
460
461 #define isSpec(c) (TAG_SPEC_MIN<=(c) && (c)<=TAG_SPEC_MAX)
462
463 #define NONE         400          /* Dummy stub                            */
464 #define STAR         401          /* Representing the kind of types        */
465 #if TREX
466 #define ROW          402          /* Representing the kind of rows         */
467 #endif
468 #define WILDCARD     403          /* Wildcard pattern                      */
469 #define SKOLEM       404          /* Skolem constant                       */
470
471 #define DOTDOT       405          /* ".." in import/export list            */
472
473 #define NAME         406          /* whatIs code for isName                */
474 #define TYCON        407          /* whatIs code for isTycon               */
475 #define CLASS        408          /* whatIs code for isClass               */
476 #define MODULE       409          /* whatIs code for isModule              */
477 #define INSTANCE     410          /* whatIs code for isInst                */
478 #define TUPLE        411          /* whatIs code for tuple constructor     */
479 #define OFFSET       412          /* whatis code for offset                */
480 #define AP           413          /* whatIs code for application node      */
481 #define CHARCELL     414          /* whatIs code for isChar                */
482 #if TREX
483 #define EXT          415          /* whatIs code for isExt                 */
484 #endif
485
486 #define SIGDECL      416          /* Signature declaration                 */
487 #define FIXDECL      417          /* Fixity declaration                    */
488 #define FUNBIND      418          /* Function binding                      */
489 #define PATBIND      419          /* Pattern binding                       */
490
491 #define DATATYPE     420          /* Datatype type constructor             */
492 #define NEWTYPE      421          /* Newtype type constructor              */
493 #define SYNONYM      422          /* Synonym type constructor              */
494 #define RESTRICTSYN  423          /* Synonym with restricted scope         */
495
496 #define NODEPENDS    424          /* Stop calculation of deps in type check*/
497 #define PREDEFINED   425          /* Predefined name, not yet filled       */
498 #define TEXTCELL     426          /* whatIs code for isText                */
499 #define INVAR        427          /* whatIs code for isInventedVar         */
500 #define INDVAR       428          /* whatIs code for isInventedDictVar     */
501
502
503 /* --------------------------------------------------------------------------
504  * Tuple data/type constructors:
505  * ------------------------------------------------------------------------*/
506
507 extern Text ghcTupleText    ( Tycon );
508 extern Text ghcTupleText_n  ( Int );
509
510
511
512 #if TREX
513 #error TREX not supported
514 #define EXTMIN       301
515 #define isExt(c)     (EXTMIN<=(c) && (c)<OFFMIN)
516 #define extText(e)   tabExt[(e)-EXTMIN]
517 #define extField(c)  arg(fun(c))
518 #define extRow(c)    arg(c)
519
520 extern Text          DECTABLE(tabExt);
521 extern Ext           mkExt ( Text );
522 #else
523 #define mkExt(t) NIL
524 #endif
525
526 extern Module        findFakeModule ( Text t );
527 extern Tycon         addTupleTycon ( Int n );
528 extern Name          addWiredInBoxingTycon
529                         ( String modNm, String typeNm, String constrNm,
530                           Int rep, Kind kind );
531 extern Tycon         addWiredInEnumTycon 
532                         ( String modNm, String typeNm, 
533                           List /*of Text*/ constrs );
534
535 /* --------------------------------------------------------------------------
536  * Offsets: (generic types/stack offsets)
537  * ------------------------------------------------------------------------*/
538
539 #define OFF_MIN 1000
540 #define OFF_MAX 1999
541
542 #define isOffset(c)  (OFF_MIN<=(c) && (c)<=OFF_MAX)
543 #define offsetOf(c)  ((c)-OFF_MIN)
544 #define mkOffset(o)  (OFF_MIN+(o))
545
546
547 /* --------------------------------------------------------------------------
548  * Modules:
549  * ------------------------------------------------------------------------*/
550
551 #define MODULE_BASE_ADDR     5000000
552 #define MODULE_MAX_SIZE      900000
553 #define MODULE_INIT_SIZE     4
554
555 #ifdef DEBUG_STORAGE
556 extern struct strModule* generate_module_ref ( Cell );
557 #define module(mod)  (*generate_module_ref(mod))
558 #else
559 #define module(mod)   tabModule[(mod)-MODULE_BASE_ADDR]
560 #endif
561
562 #define mkModule(n)   (MODULE_BASE_ADDR+(n))
563 #define isModule(c)   (MODULE_BASE_ADDR<=(c)                  \
564                        && (c)<MODULE_BASE_ADDR+tabModuleSz    \
565                        && tabModule[(c)-MODULE_BASE_ADDR].inUse)
566
567
568 /* Import defns for the ObjectCode struct in Module. */
569 #include "object.h"
570
571 /* Import a machine-dependent definition of Time, for module timestamps. */
572 #include "machdep_time.h"
573
574 /* Under Haskell 1.3, the list of qualified imports is always a subset
575  * of the list of unqualified imports.  For simplicity and flexibility,
576  * we do not attempt to exploit this fact - when a module is imported
577  * unqualified, it is added to both the qualified and unqualified
578  * import lists.
579  * Similarily, Haskell 1.3 does not allow a constructor to be imported
580  * or exported without exporting the type it belongs to but the export
581  * list is just a flat list of Texts (before static analysis) or
582  * Tycons, Names and Classes (after static analysis).
583  */
584 struct strModule {
585    Bool   inUse;
586    Name   nextFree;
587
588    Text   text;        /* Name of this module                              */
589
590    List   tycons;      /* Lists of top level objects ...                   */
591    List   names;       /* (local defns + imports)                          */
592    List   classes;
593    List   exports;     /* [ Entity | (Entity, NIL|DOTDOT) ]                */
594
595    List   qualImports; /* Qualified imports.                               */
596
597    Bool   fake;        /* TRUE if module exists only via GHC primop        */
598                        /* defn; usually FALSE                              */
599
600    Cell   tree;        /* Parse tree for mod or iface                      */
601    Bool   completed;   /* Fully loaded or just parsed?                     */
602    Time   lastStamp;   /* Time of last parse                               */
603
604    Bool   fromSrc;     /* is it from source ?                              */
605    Text   srcExt;      /* if yes, ".lhs", ".hs", etc"                      */
606    List   uses;        /* :: [CONID] -- names of mods imported by this one */
607
608    Text   objName;     /* Name of the primary object code file.            */
609    Int    objSize;     /* Size of the primary object code file.            */
610
611    ObjectCode* object;        /* Primary object code for this module.      */
612    ObjectCode* objectExtras;  /* And any extras it might need.             */
613    List   objectExtraNames;   /* :: [Text] -- names of extras              */
614 };
615
616 extern struct strModule* tabModule;
617 extern Int               tabModuleSz;
618
619 extern Module currentModule;           /* Module currently being processed */
620 extern List   moduleGraph;             /* :: [GRP_REC | GRP_NONREC]        */
621 extern List   prelModules;             /* :: [CONID]                       */
622 extern List   targetModules;           /* :: [CONID]                       */
623
624
625 extern Bool         isValidModule   ( Module );
626 extern Module       newModule       ( Text );
627 extern Void         nukeModule      ( Module );
628 extern Module       findModule      ( Text );
629 extern Module       findModid       ( Cell );
630 extern Void         setCurrModule   ( Module );
631
632 extern void         addOTabName     ( Module,char*,void* );
633 extern void*        lookupOTabName  ( Module,char* );
634 extern char*        nameFromOPtr    ( void* );
635
636 extern void         addSection      ( Module,void*,void*,OSectionKind );
637 extern OSectionKind lookupSection   ( void* );
638 extern void*    lookupOExtraTabName ( char* sym );
639
640 #define isPrelude(m) (m==modulePrelude)
641
642 #define N_PRELUDE_SCRIPTS (combined ? 32 : 1)
643
644 /* --------------------------------------------------------------------------
645  * Type constructor names:
646  * ------------------------------------------------------------------------*/
647
648 #define TYCON_BASE_ADDR   2000000
649 #define TYCON_MAX_SIZE    900000
650 #define TYCON_INIT_SIZE   4
651
652 #ifdef DEBUG_STORAGE
653 extern struct strTycon* generate_tycon_ref ( Cell );
654 #define tycon(tc)    (*generate_tycon_ref(tc))
655 #else
656 #define tycon(tc)    tabTycon[(tc)-TYCON_BASE_ADDR]
657 #endif
658
659 #define isTycon(c)   (TYCON_BASE_ADDR<=(c)                        \
660                       && (c)<TYCON_BASE_ADDR+tabTyconSz           \
661                       && tabTycon[(c)-TYCON_BASE_ADDR].inUse      \
662                       && tabTycon[(c)-TYCON_BASE_ADDR].tuple==-1)
663 #define isTuple(c)   (TYCON_BASE_ADDR<=(c)                        \
664                       && (c)<TYCON_BASE_ADDR+tabTyconSz           \
665                       && tabTycon[(c)-TYCON_BASE_ADDR].inUse      \
666                       && tabTycon[(c)-TYCON_BASE_ADDR].tuple>=0)
667 #define tupleOf(n)   (tycon(n).tuple)
668
669 extern Tycon mkTuple ( Int );
670
671
672 struct strTycon {
673     Bool   inUse;
674     Name   nextFree;
675     Text   text;
676     Int    line;
677     Module mod;                         /* module that defines it          */
678     Int    tuple;                      /* tuple number, or -1 if not tuple */
679     Int    arity;
680     Kind   kind;                        /* kind (includes arity) of Tycon  */
681     Cell   what;                        /* DATATYPE/SYNONYM/RESTRICTSYN... */
682     Cell   defn;
683     Name   conToTag;                    /* used in derived code            */
684     Name   tagToCon;
685     void*  itbl;                       /* For tuples, the info tbl pointer */
686     Tycon  nextTyconHash;
687 };
688
689 extern struct strTycon* tabTycon;
690 extern Int              tabTyconSz;
691
692 extern Tycon newTycon     ( Text );
693 extern Tycon findTycon    ( Text );
694 extern Tycon addTycon     ( Tycon );
695 extern Tycon findQualTycon ( Cell );
696 extern Tycon addPrimTycon ( Text,Kind,Int,Cell,Cell );
697
698 #define isSynonym(h)    (isTycon(h) && tycon(h).what==SYNONYM)
699 #define isQualType(t)   (isPair(t) && fst(t)==QUAL)
700 #define mkPolyType(n,t) pair(POLYTYPE,pair(n,t))
701 #define isPolyType(t)   (isPair(t) && fst(t)==POLYTYPE)
702 #define isPolyOrQualType(t) (isPair(t) && (fst(t)==POLYTYPE || fst(t)==QUAL))
703 #define polySigOf(t)    fst(snd(t))
704 #define monotypeOf(t)   snd(snd(t))
705 #define bang(t)         ap(BANG,t)
706
707 extern Tycon findQualTyconWithoutConsultingExportList ( QualId q );
708
709 /* --------------------------------------------------------------------------
710  * Globally defined name values:
711  * ------------------------------------------------------------------------*/
712
713 #define NAME_BASE_ADDR    1000000
714 #define NAME_MAX_SIZE     900000
715 #define NAME_INIT_SIZE    4
716
717 #ifdef DEBUG_STORAGE
718 extern struct strName* generate_name_ref ( Cell );
719 #define name(nm)    (*generate_name_ref(nm))
720 #else
721 #define name(nm)    tabName[(nm)-NAME_BASE_ADDR]
722 #endif
723
724 #define mkName(n)   (NAME_BASE_ADDR+(n))
725 #define isName(c)   (NAME_BASE_ADDR<=(c)                   \
726                      && (c)<NAME_BASE_ADDR+tabNameSz       \
727                      && tabName[(c)-NAME_BASE_ADDR].inUse)
728
729 struct strName {
730     Bool   inUse;
731     Name   nextFree;
732     Text   text;
733     Int    line;
734     Module mod;                         /* module that defines it          */
735     Syntax syntax;
736     Cell   parent; 
737     Int    arity;
738     Int    number;
739     Cell   type;
740     Cell   defn;
741     Cell   stgVar;                                      /* really StgVar   */
742     Text   callconv;                          /* for foreign import/export */
743     void*  primop;                                      /* really StgPrim* */
744     void*  itbl;                 /* For constructors, the info tbl pointer */
745     Name   nextNameHash;
746 };
747
748 extern struct strName* tabName;
749 extern Int             tabNameSz;
750
751 extern int numNames (  Void  );
752
753 /* The number field in a name is used to distinguish various kinds of name:
754  *   mfunNo(i) = code for member function, offset i
755  *               members that are sole elements of dict use mfunNo(0)
756  *               members of dicts with more than one elem use mfunNo(n), n>=1
757  *   EXECNAME  = code for executable name (bytecodes or primitive)
758  *   SELNAME   = code for selector function
759  *   DFUNNAME  = code for dictionary builder or selector
760  *   cfunNo(i) = code for data constructor
761  *               datatypes with only one constructor uses cfunNo(0)
762  *               datatypes with multiple constructors use cfunNo(n), n>=1
763  */
764
765 #define EXECNAME        0
766 #define SELNAME         1
767 #define DFUNNAME        2
768 #define CFUNNAME        3
769
770 #define isSfun(n)       (name(n).number==SELNAME)
771 #define isDfun(n)       (name(n).number==DFUNNAME)
772
773 #define isCfun(n)       (name(n).number>=CFUNNAME)
774 #define cfunOf(n)       (name(n).number-CFUNNAME)
775 #define cfunNo(i)       ((i)+CFUNNAME)
776 #define hasCfun(cs)     (nonNull(cs) && isCfun(hd(cs)))
777
778 #define isMfun(n)       (name(n).number<0)
779 #define mfunOf(n)       ((-1)-name(n).number)
780 #define mfunNo(i)       ((-1)-(i))
781
782 extern Name   newName         ( Text,Cell );
783 extern Name   findName        ( Text );
784 extern Name   addName         ( Name );
785 extern Name   findQualName    ( Cell );
786 extern Name   addPrimCfun     ( Text,Int,Int,Cell );
787 extern Name   addPrimCfunREP  ( Text,Int,Int,Int );
788 extern Int    sfunPos         ( Name,Name );
789 extern Name   nameFromStgVar  ( Cell );
790 extern Name   jrsFindQualName ( Text,Text );
791
792 extern Name findQualNameWithoutConsultingExportList ( QualId q );
793
794 /* --------------------------------------------------------------------------
795  * Type class values:
796  * ------------------------------------------------------------------------*/
797
798 #define INST_BASE_ADDR     4000000
799 #define INST_MAX_SIZE      900000
800 #define INST_INIT_SIZE     4
801
802 #ifdef DEBUG_STORAGE
803 extern struct strInst* generate_inst_ref ( Cell );
804 #define inst(in)    (*generate_inst_ref(in))
805 #else
806 #define inst(in)    tabInst[(in)-INST_BASE_ADDR]
807 #endif
808
809 #define mkInst(n)   (INST_BASE_ADDR+(n))
810 #define instOf(c)   ((Int)((c)-INST_BASE_ADDR))
811 #define isInst(c)   (INST_BASE_ADDR<=(c)                   \
812                      && (c)<INST_BASE_ADDR+tabInstSz       \
813                      && tabInst[(c)-INST_BASE_ADDR].inUse)
814
815 struct strInst {
816     Bool   inUse;
817     Name   nextFree;
818     Class  c;                           /* class C                         */
819     Int    line;
820     Module mod;                         /* module that defines it          */
821     Kinds  kinds;                       /* Kinds of variables in head      */
822     Cell   head;                        /* :: Pred                         */
823     List   specifics;                   /* :: [Pred]                       */
824     Int    numSpecifics;                /* length(specifics)               */
825     List   implements;
826     Name   builder;                     /* Dictionary constructor function */
827 };
828
829 extern struct strInst* tabInst;
830 extern Int             tabInstSz;
831
832 /* a predicate (an element :: Pred) is an application of a Class to one or
833  * more type expressions
834  */
835
836 #define CCLASS_BASE_ADDR   3000000
837 #define CCLASS_MAX_SIZE    900000
838 #define CCLASS_INIT_SIZE   4
839
840 #ifdef DEBUG_STORAGE
841 extern struct strClass* generate_cclass_ref ( Cell );
842 #define cclass(cl)   (*generate_cclass_ref(cl))
843 #else
844 #define cclass(cl)   tabClass[(cl)-CCLASS_BASE_ADDR]
845 #endif
846
847 #define mkClass(n)   (CCLASS_BASE_ADDR+(n))
848 #define isClass(c)   (CCLASS_BASE_ADDR<=(c)                   \
849                       && (c)<CCLASS_BASE_ADDR+tabClassSz      \
850                       && tabClass[(c)-CCLASS_BASE_ADDR].inUse)
851
852 struct strClass {
853     Bool   inUse;
854     Name   nextFree;
855     Text   text;                        /* Name of class                   */
856     Int    line;                        /* Line where declaration begins   */
857     Module mod;                         /* module that declares it         */
858     Int    level;                       /* Level in class hierarchy        */
859     Int    arity;                       /* Number of arguments             */
860     Kinds  kinds;                       /* Kinds of constructors in class  */
861     List   fds;                         /* Functional Dependencies         */
862     List   xfds;                        /* Xpanded Functional Dependencies */
863     Cell   head;                        /* Head of class                   */
864     Name   dcon;                        /* Dictionary constructor function */
865     List   supers;                      /* :: [Pred]                       */
866     Int    numSupers;                   /* length(supers)                  */
867     List   dsels;                       /* Superclass dictionary selectors */
868     List   members;                     /* :: [Name]                       */
869     Int    numMembers;                  /* length(members)                 */
870     List   defaults;                    /* :: [Name]                       */
871     List   instances;                   /* :: [Inst]                       */
872 };
873
874 extern struct strClass* tabClass;
875 extern Int              tabClassSz;
876
877 extern Class newClass      ( Text );
878 extern Class findClass     ( Text );
879 extern Class addClass      ( Class );
880 extern Class findQualClass ( Cell );
881 extern Inst  newInst       ( Void );
882 extern Inst  findFirstInst ( Tycon );
883 extern Inst  findNextInst  ( Tycon,Inst );
884 extern List  getAllKnownTyconsAndClasses ( void );
885 extern Class findQualClassWithoutConsultingExportList ( QualId q );
886
887 /* --------------------------------------------------------------------------
888  * Character values:
889  * ------------------------------------------------------------------------*/
890
891 /* I think this assumes that NUM_CHARS==256. */
892 #define CHAR_MIN     3000
893 #define CHAR_MAX     3255
894 #define isChar(c)    (CHAR_MIN<=(c) && (c)<=CHAR_MAX)
895 #define charOf(c)    ((Char)((c)-CHAR_MIN))
896 #define mkChar(c)    (CHAR_MIN+(((Cell)(c)) & 0xFF))
897 #define MAXCHARVAL   (NUM_CHARS-1)
898
899 /* --------------------------------------------------------------------------
900  * Small Integer values:
901  * ------------------------------------------------------------------------*/
902
903 #define SMALL_INT_MIN   100000
904 #define SMALL_INT_MAX   499999
905 #define SMALL_INT_ZERO  (1 + SMALL_INT_MIN/2 + SMALL_INT_MAX/2)
906 #define isSmall(c)      (SMALL_INT_MIN<=(c) && (c)<=SMALL_INT_MAX)
907 extern  Bool isInt      ( Cell );
908 extern  Int  intOf      ( Cell );
909 extern  Cell mkInt      ( Int );
910
911 /* --------------------------------------------------------------------------
912  * Implementation of triples:
913  * ------------------------------------------------------------------------*/
914
915 #define triple(x,y,z) pair(x,pair(y,z))
916 #define fst3(c)      fst(c)
917 #define snd3(c)      fst(snd(c))
918 #define thd3(c)      snd(snd(c))
919
920 /* --------------------------------------------------------------------------
921  * Implementation of lists:
922  * ------------------------------------------------------------------------*/
923
924 #define NIL              0
925 #define isNull(c)        ((c)==NIL)
926 #define nonNull(c)       (c)
927 #define cons(x,xs)       pair(x,xs)
928 #define singleton(x)     cons(x,NIL)
929 #define doubleton(x,y)   cons(x,cons(y,NIL))
930 #define tripleton(x,y,z) cons(x,cons(y,cons(z,NIL)))
931 #define hd(c)            fst(c)
932 #define tl(c)            snd(c)
933
934 extern  Int          length       ( List );
935 extern  List         appendOnto   ( List,List );    /* destructive     */
936 extern  List         dupOnto      ( List,List );
937 extern  List         dupList      ( List );
938 extern  List         revOnto      ( List, List );   /* destructive     */
939 #define rev(xs)      revOnto((xs),NIL)              /* destructive     */
940 #define reverse(xs)  revOnto(dupList(xs),NIL)       /* non-destructive */
941 extern  Cell         cellIsMember ( Cell,List );
942 extern  Cell         cellAssoc    ( Cell,List );
943 extern  Cell         cellRevAssoc ( Cell,List );
944 extern  Bool         eqList       ( List,List );
945 extern  Cell         varIsMember  ( Text,List );
946 extern  Name         nameIsMember ( Text,List );
947 extern  QualId       qualidIsMember ( QualId, List );
948 extern  Cell         intIsMember  ( Int,List );
949 extern  List         replicate    ( Int,Cell );
950 extern  List         diffList     ( List,List );    /* destructive     */
951 extern  List         deleteCell   ( List,Cell );    /* non-destructive */
952 extern  List         take         ( Int,List );     /* destructive     */
953 extern  List         splitAt      ( Int,List );     /* non-destructive */
954 extern  Cell         nth          ( Int,List );
955 extern  List         removeCell   ( Cell,List );    /* destructive     */
956 extern  List         dupListOnto  ( List,List );    /* non-destructive */ 
957 extern  List         nubList      ( List );         /* non-destructive */
958
959 /* The following macros provide `inline expansion' of some common ways of
960  * traversing, using and modifying lists:
961  *
962  * N.B. We use the names _f, _a, _xs, Zs, in an attempt to avoid clashes
963  *      with identifiers used elsewhere.
964  */
965
966 #define mapBasic(_init,_step)           {List Zs=(_init);\
967                                          for(;nonNull(Zs);Zs=tl(Zs))  \
968                                          _step;}
969 #define mapModify(_init,_step)          mapBasic(_init,hd(Zs)=_step)
970
971 #define mapProc(_f,_xs)                 mapBasic(_xs,_f(hd(Zs)))
972 #define map1Proc(_f,_a,_xs)             mapBasic(_xs,_f(_a,hd(Zs)))
973 #define map2Proc(_f,_a,_b,_xs)          mapBasic(_xs,_f(_a,_b,hd(Zs)))
974 #define map3Proc(_f,_a,_b,_c,_xs)       mapBasic(_xs,_f(_a,_b,_c,hd(Zs)))
975 #define map4Proc(_f,_a,_b,_c,_d,_xs)    mapBasic(_xs,_f(_a,_b,_c,_d,hd(Zs)))
976
977 #define mapOver(_f,_xs)                 mapModify(_xs,_f(hd(Zs)))
978 #define map1Over(_f,_a,_xs)             mapModify(_xs,_f(_a,hd(Zs)))
979 #define map2Over(_f,_a,_b,_xs)          mapModify(_xs,_f(_a,_b,hd(Zs)))
980 #define map3Over(_f,_a,_b,_c,_xs)       mapModify(_xs,_f(_a,_b,_c,hd(Zs)))
981 #define map4Over(_f,_a,_b,_c,_d,_xs)    mapModify(_xs,_f(_a,_b,_c,_d,hd(Zs)))
982
983 /* This is just what you want for functions with accumulating parameters */
984 #define mapAccum(_f,_acc,_xs)           mapBasic(_xs,_acc=_f(_acc,hd(Zs)))
985 #define map1Accum(_f,_acc,_a,_xs)       mapBasic(_xs,_acc=_f(_acc,_a,hd(Zs)))
986 #define map2Accum(_f,_acc,_a,_b,_xs)    mapBasic(_xs,_acc=_f(_acc,_a,_b,hd(Zs)))
987 #define map3Accum(_f,_acc,_a,_b,_c,_xs) mapBasic(_xs,_acc=_f(_acc,_a,_b,_c,hd(Zs)))
988
989
990 /* --------------------------------------------------------------------------
991  * Strongly-typed lists (z-lists) and tuples (experimental)
992  * ------------------------------------------------------------------------*/
993
994 typedef Cell ZPair;
995 typedef Cell ZTriple;
996 typedef Cell Z4Ble;
997 typedef Cell Z5Ble;
998
999 #define isZPair(c) (whatIs((c))==ZTUP2)
1000
1001 extern Cell zpair    ( Cell x1, Cell x2 );
1002 extern Cell zfst     ( Cell zpair );
1003 extern Cell zsnd     ( Cell zpair );
1004
1005 extern Cell ztriple  ( Cell x1, Cell x2, Cell x3 );
1006 extern Cell zfst3    ( Cell zpair );
1007 extern Cell zsnd3    ( Cell zpair );
1008 extern Cell zthd3    ( Cell zpair );
1009
1010 extern Cell z4ble    ( Cell x1, Cell x2, Cell x3, Cell x4 );
1011 extern Cell zsel14   ( Cell zpair );
1012 extern Cell zsel24   ( Cell zpair );
1013 extern Cell zsel34   ( Cell zpair );
1014 extern Cell zsel44   ( Cell zpair );
1015
1016 extern Cell z5ble    ( Cell x1, Cell x2, Cell x3, Cell x4, Cell x5 );
1017 extern Cell zsel15   ( Cell zpair );
1018 extern Cell zsel25   ( Cell zpair );
1019 extern Cell zsel35   ( Cell zpair );
1020 extern Cell zsel45   ( Cell zpair );
1021 extern Cell zsel55   ( Cell zpair );
1022
1023 extern Cell unap     ( int tag, Cell c );
1024
1025
1026 /* --------------------------------------------------------------------------
1027  * Implementation of function application nodes:
1028  * ------------------------------------------------------------------------*/
1029
1030 #define ap(f,x)      pair(f,x)
1031 #define ap1(f,x)     ap(f,x)
1032 #define ap2(f,x,y)   ap(ap(f,x),y)
1033 #define ap3(f,x,y,z) ap(ap(ap(f,x),y),z)
1034 #define fun(c)       fst(c)
1035 #define arg(c)       snd(c)
1036 #define isAp(c)      (isPair(c) && !isTag(fst(c)))
1037
1038 extern  Cell         getHead     ( Cell );
1039 extern  List         getArgs     ( Cell );
1040 extern  Cell         nthArg      ( Int,Cell );
1041 extern  Int          numArgs     ( Cell );
1042 extern  Cell         applyToArgs ( Cell,List );
1043 extern  Int          argCount;
1044
1045 /* --------------------------------------------------------------------------
1046  * Stack implementation:
1047  *
1048  * NB: Use of macros makes order of evaluation hard to predict.
1049  *     For example, "push(1+pop());" doesn't increment TOS.
1050  * ------------------------------------------------------------------------*/
1051
1052 extern  Cell cellStack[];
1053 extern  StackPtr sp;
1054
1055 #define clearStack() sp=(-1)
1056 #define stackEmpty() (sp==(-1))
1057 #define stack(p)     cellStack[p]
1058 #define chkStack(n)  if (sp>=NUM_STACK-(n)) hugsStackOverflow()
1059 #define push(c)      do { chkStack(1); onto(c); } while (0)
1060 #define onto(c)      stack(++sp)=(c);
1061 #define pop()        stack(sp--)
1062 #define drop()       sp--
1063 #define top()        stack(sp)
1064 #define pushed(n)    stack(sp-(n))
1065 #define topfun(f)    top()=ap((f),top())
1066 #define toparg(x)    top()=ap(top(),(x))
1067
1068 extern  Void hugsStackOverflow ( Void );
1069
1070 #if SYMANTEC_C
1071 #include <Memory.h>
1072 #define STACK_HEADROOM 16384
1073 #define STACK_CHECK if (StackSpace() <= STACK_HEADROOM) \
1074                       internal("Macintosh function parameter stack overflow.");
1075 #else
1076 #define STACK_CHECK
1077 #endif
1078
1079 /* --------------------------------------------------------------------------
1080  * Misc:
1081  * ------------------------------------------------------------------------*/
1082
1083 extern  Void   setLastExpr          ( Cell );
1084 extern  Cell   getLastExpr          ( Void );
1085 extern  List   addTyconsMatching    ( String,List );
1086 extern  List   addNamesMatching     ( String,List );
1087
1088 extern  Tycon  findTyconInAnyModule ( Text t );
1089 extern  Class  findClassInAnyModule ( Text t );
1090 extern  Name   findNameInAnyModule  ( Text t );
1091
1092 extern  Void   print                ( Cell, Int );
1093 extern  void   dumpTycon            ( Int t );
1094 extern  void   dumpName             ( Int n );
1095 extern  void   dumpClass            ( Int c );
1096 extern  void   dumpInst             ( Int i );
1097 extern  void   locateSymbolByName   ( Text t );
1098
1099 /*-------------------------------------------------------------------------*/