2 /* --------------------------------------------------------------------------
3 * Defines storage datatypes: Text, Name, Module, Tycon, Cell, List, Pair,
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.
12 * $RCSfile: storage.h,v $
14 * $Date: 2000/03/13 11:37:17 $
15 * ------------------------------------------------------------------------*/
17 /* --------------------------------------------------------------------------
18 * Typedefs for main data types:
19 * Many of these type names are used to indicate the intended us of a data
20 * item, rather than for type checking purposes. Sadly (although sometimes,
21 * fortunately), the C compiler cannot distinguish between the use of two
22 * different names defined to be synonyms for the same types.
23 * ------------------------------------------------------------------------*/
25 typedef Int Text; /* text string */
26 typedef Unsigned Syntax; /* syntax (assoc,preced) */
27 typedef Int Cell; /* general cell value */
28 typedef Cell far *Heap; /* storage of heap */
29 typedef Cell Pair; /* pair cell */
30 typedef Int StackPtr; /* stack pointer */
31 typedef Cell Offset; /* offset/generic variable*/
32 typedef Int Script; /* script file number */
33 typedef Int Module; /* module */
34 typedef Cell Tycon; /* type constructor */
35 typedef Cell Type; /* type expression */
36 typedef Cell Kind; /* kind expression */
37 typedef Cell Kinds; /* list of kinds */
38 typedef Cell Constr; /* constructor expression */
39 typedef Cell Name; /* named value */
40 typedef Cell Class; /* type class */
41 typedef Cell Inst; /* instance of type class */
42 typedef Cell Triple; /* triple of cell values */
43 typedef Cell List; /* list of cells */
44 typedef Cell Bignum; /* bignum integer */
45 typedef Cell Float; /* floating pt literal */
47 typedef Cell Ext; /* extension label */
53 typedef Cell ConVarId;
55 /* --------------------------------------------------------------------------
57 * provides storage for the characters making up identifier and symbol
58 * names, string literals, character constants etc...
59 * ------------------------------------------------------------------------*/
61 extern String textToStr ( Text );
62 extern Text findText ( String );
63 extern Text inventText ( Void );
64 extern Text inventDictText ( Void );
65 extern Bool inventedText ( Text );
66 extern Text enZcodeThenFindText ( String );
67 extern Text unZcodeThenFindText ( String );
69 /* Variants of textToStr and syntaxOf which work for idents, ops whether
70 * qualified or unqualified.
72 extern String identToStr ( Cell );
73 extern Text fixLitText ( Text );
74 extern Syntax identSyntax ( Cell );
75 extern Syntax defaultSyntax ( Text );
77 /* --------------------------------------------------------------------------
78 * Specification of syntax (i.e. default written form of application)
79 * ------------------------------------------------------------------------*/
81 #define MIN_PREC 0 /* weakest binding operator */
82 #define MAX_PREC 9 /* strongest binding operator */
83 #define FUN_PREC (MAX_PREC+2) /* binding of function symbols */
84 #define DEF_PREC MAX_PREC
85 #define APPLIC 0 /* written applicatively */
86 #define LEFT_ASS 1 /* left associative infix */
87 #define RIGHT_ASS 2 /* right associative infix */
88 #define NON_ASS 3 /* non associative infix */
89 #define DEF_ASS LEFT_ASS
91 #define UMINUS_PREC 6 /* Change these settings at your */
92 #define UMINUS_ASSOC LEFT_ASS /* own risk; they may not work! */
94 #define assocOf(x) ((x)&NON_ASS)
95 #define precOf(x) ((x)>>2)
96 #define mkSyntax(a,p) ((a)|((p)<<2))
97 #define DEF_OPSYNTAX mkSyntax(DEF_ASS,DEF_PREC)
98 #define NO_SYNTAX (-1)
100 extern Void addSyntax ( Int,Text,Syntax );
101 extern Syntax syntaxOf ( Text );
103 /* --------------------------------------------------------------------------
105 * Provides a garbage collectable heap for storage of expressions etc.
106 * ------------------------------------------------------------------------*/
108 #define heapAlloc(s) (Heap)(farCalloc(s,sizeof(Cell)))
109 #define heapBuilt() (heapFst)
111 extern Heap heapFst, heapSnd;
112 extern Heap heapTopFst;
113 extern Heap heapTopSnd;
114 extern Bool consGC; /* Set to FALSE to turn off gc from*/
115 /* C stack; use with extreme care! */
116 extern Int cellsRecovered; /* cells recovered by last gc */
118 #define fst(c) heapTopFst[c]
119 #define snd(c) heapTopSnd[c]
121 extern Pair pair ( Cell,Cell );
122 extern Void garbageCollect ( Void );
124 extern Void overwrite ( Pair,Pair );
125 extern Void overwrite2 ( Pair,Cell,Cell );
126 extern Cell markExpr ( Cell );
127 extern Void markWithoutMove ( Cell );
129 #define mark(v) v=markExpr(v)
131 #define isPair(c) ((c)<0)
132 #define isGenPair(c) ((c)<0 && -heapSize<=(c))
134 extern Cell whatIs ( Cell );
136 /* --------------------------------------------------------------------------
137 * Box cell tags are used as the fst element of a pair to indicate that
138 * the snd element of the pair is to be treated in some special way, other
139 * than as a Cell. Examples include holding integer values, variable name
140 * and string text etc.
141 * ------------------------------------------------------------------------*/
143 #if !defined(SIZEOF_VOID_P) || !defined(SIZEOF_INT)
144 #error SIZEOF_VOID_P or SIZEOF_INT is not defined
147 #define TAGMIN 1 /* Box and constructor cell tag values */
148 #define BCSTAG 30 /* Box=TAGMIN..BCSTAG-1 */
149 #define isTag(c) (TAGMIN<=(c) && (c)<SPECMIN) /* Tag cell values */
150 #define isBoxTag(c) (TAGMIN<=(c) && (c)<BCSTAG) /* Box cell tag values */
151 #define isConTag(c) (BCSTAG<=(c) && (c)<SPECMIN) /* Constr cell tag values*/
153 #define FREECELL 3 /* Free list cell: snd :: Cell */
154 #define VARIDCELL 4 /* Identifier variable: snd :: Text */
155 #define VAROPCELL 5 /* Operator variable: snd :: Text */
156 #define DICTVAR 6 /* Dictionary variable: snd :: Text */
157 #define CONIDCELL 7 /* Identifier constructor: snd :: Text */
158 #define CONOPCELL 8 /* Operator constructor: snd :: Text */
159 #define STRCELL 9 /* String literal: snd :: Text */
160 #define INTCELL 10 /* Int literal: snd :: Int */
161 #define ADDPAT 11 /* (_+k) pattern discr: snd :: Int */
162 #define FLOATCELL 15 /* Floating Pt literal: snd :: Text */
163 #define BIGCELL 16 /* Integer literal: snd :: Text */
164 #define PTRCELL 17 /* C Heap Pointer snd :: Ptr */
165 #define CPTRCELL 21 /* Native code pointer snd :: Ptr */
168 #define IPCELL 19 /* Imp Param Cell: snd :: Text */
169 #define IPVAR 20 /* ?x: snd :: Text */
173 #define EXTCOPY 22 /* Copy of an Ext: snd :: Text */
176 #define qmodOf(c) (textOf(fst(snd(c)))) /* c :: QUALIDENT */
177 #define qtextOf(c) (textOf(snd(snd(c)))) /* c :: QUALIDENT */
178 #define mkVar(t) ap(VARIDCELL,t)
179 #define mkVarop(t) ap(VAROPCELL,t)
180 #define mkCon(t) ap(CONIDCELL,t)
181 #define mkConop(t) ap(CONOPCELL,t)
182 #define mkQVar(m,t) ap(QUALIDENT,pair(mkCon(m),mkVar(t)))
183 #define mkQCon(m,t) ap(QUALIDENT,pair(mkCon(m),mkCon(t)))
184 #define mkQVarOp(m,t) ap(QUALIDENT,pair(mkCon(m),mkVarop(t)))
185 #define mkQConOp(m,t) ap(QUALIDENT,pair(mkCon(m),mkConop(t)))
186 #define mkQualId(m,t) ap(QUALIDENT,pair(m,t))
187 #define intValOf(c) (snd(c))
188 #define inventVar() mkVar(inventText())
189 #define mkDictVar(t) ap(DICTVAR,t)
190 #define inventDictVar() mkDictVar(inventDictText())
191 #define mkStr(t) ap(STRCELL,t)
193 #define mkIParam(c) ap(IPCELL,snd(c))
194 #define isIP(p) (whatIs(p) == IPCELL)
195 #define ipMatch(pi, t) (isIP(fun(pi)) && textOf(fun(pi)) == t)
196 #define ipVar(pi) textOf(fun(pi))
198 #define isIP(p) FALSE
201 extern Bool isVar ( Cell );
202 extern Bool isCon ( Cell );
203 extern Bool isQVar ( Cell );
204 extern Bool isQCon ( Cell );
205 extern Bool isQualIdent ( Cell );
206 extern Bool eqQualIdent ( QualId c1, QualId c2 );
207 extern Bool isIdent ( Cell );
208 extern String stringNegate ( String );
209 extern Text textOf ( Cell );
211 #define isFloat(c) (isPair(c) && fst(c)==FLOATCELL)
212 #define stringToFloat(s) pair(FLOATCELL,findText(s))
213 #define floatToString(f) textToStr(snd(f))
214 #define floatOf(f) atof(floatToString(f))
215 #define mkFloat(f) (f) /* ToDo: is this right? */
216 #define floatNegate(f) stringToFloat(stringNegate(floatToString(f)))
218 #define stringToBignum(s) pair(BIGCELL,findText(s))
219 #define bignumToString(b) textToStr(snd(b))
221 #define isPtr(c) (isPair(c) && fst(c)==PTRCELL)
222 extern Cell mkPtr ( Ptr );
223 extern Ptr ptrOf ( Cell );
224 #define isCPtr(c) (isPair(c) && fst(c)==CPTRCELL)
225 extern Cell mkCPtr ( Ptr );
226 extern Ptr cptrOf ( Cell );
228 /* --------------------------------------------------------------------------
229 * Constructor cell tags are used as the fst element of a pair to indicate
230 * a particular syntactic construct described by the snd element of the
232 * Note that a cell c will not be treated as an application (AP/isAp) node
233 * if its first element is a constructor cell tag, whereas a cell whose fst
234 * element is a special cell will be treated as an application node.
235 * ------------------------------------------------------------------------*/
237 #define LETREC 30 /* LETREC snd :: ([Decl],Exp) */
238 #define COND 31 /* COND snd :: (Exp,Exp,Exp) */
239 #define LAMBDA 32 /* LAMBDA snd :: Alt */
240 #define FINLIST 33 /* FINLIST snd :: [Exp] */
241 #define DOCOMP 34 /* DOCOMP snd :: (Exp,[Qual]) */
242 #define BANG 35 /* BANG snd :: Type */
243 #define COMP 36 /* COMP snd :: (Exp,[Qual]) */
244 #define ASPAT 37 /* ASPAT snd :: (Var,Exp) */
245 #define ESIGN 38 /* ESIGN snd :: (Exp,Type) */
246 #define RSIGN 39 /* RSIGN snd :: (Rhs,Type) */
247 #define CASE 40 /* CASE snd :: (Exp,[Alt]) */
248 #define NUMCASE 41 /* NUMCASE snd :: (Exp,Disc,Rhs) */
249 #define FATBAR 42 /* FATBAR snd :: (Exp,Exp) */
250 #define LAZYPAT 43 /* LAZYPAT snd :: Exp */
251 #define DERIVE 45 /* DERIVE snd :: Cell */
252 #define BOOLQUAL 49 /* BOOLQUAL snd :: Exp */
253 #define QWHERE 50 /* QWHERE snd :: [Decl] */
254 #define FROMQUAL 51 /* FROMQUAL snd :: (Exp,Exp) */
255 #define DOQUAL 52 /* DOQUAL snd :: Exp */
256 #define MONADCOMP 53 /* MONADCOMP snd :: ((m,m0),(Exp,[Qual])*/
257 #define GUARDED 54 /* GUARDED snd :: [guarded exprs] */
258 #define ARRAY 55 /* Array snd :: (Bounds,[Values]) */
259 #define MUTVAR 56 /* Mutvar snd :: Cell */
260 #define HUGSOBJECT 57 /* HUGSOBJECT snd :: Cell */
263 #define WITHEXP 58 /* WITHEXP snd :: [(Var,Exp)] */
266 #define POLYTYPE 60 /* POLYTYPE snd :: (Kind,Type) */
267 #define QUAL 61 /* QUAL snd :: ([Classes],Type) */
268 #define RANK2 62 /* RANK2 snd :: (Int,Type) */
269 #define EXIST 63 /* EXIST snd :: (Int,Type) */
270 #define POLYREC 64 /* POLYREC snd :: (Int,Type) */
271 #define BIGLAM 65 /* BIGLAM snd :: (vars,patterns) */
272 #define CDICTS 66 /* CDICTS snd :: ([Pred],Type) */
274 #define LABC 67 /* LABC snd :: (con,[(Vars,Type)]) */
275 #define CONFLDS 68 /* CONFLDS snd :: (con,[Field]) */
276 #define UPDFLDS 69 /* UPDFLDS snd :: (Exp,[con],[Field]) */
278 #define RECORD 70 /* RECORD snd :: [Val] */
279 #define EXTCASE 71 /* EXTCASE snd :: (Exp,Disc,Rhs) */
280 #define RECSEL 72 /* RECSEL snd :: Ext */
282 #define IMPDEPS 73 /* IMPDEPS snd :: [Binding] */
284 #define QUALIDENT 74 /* Qualified identifier snd :: (Id,Id) */
285 #define HIDDEN 75 /* hiding import list snd :: [Entity] */
286 #define MODULEENT 76 /* module in export list snd :: con */
288 #define INFIX 77 /* INFIX snd :: (see tidyInfix) */
289 #define ONLY 78 /* ONLY snd :: Exp */
290 #define NEG 79 /* NEG snd :: Exp */
292 /* Used when parsing GHC interface files */
293 #define DICTAP 80 /* DICTAP snd :: (QClassId,[Type]) */
294 #define UNBOXEDTUP 81 /* UNBOXEDTUP snd :: [Type] */
296 #if SIZEOF_VOID_P != SIZEOF_INT
297 #define PTRCELL 82 /* C Heap Pointer snd :: (Int,Int) */
301 #define STGVAR 92 /* STGVAR snd :: (StgRhs,info) */
302 #define STGAPP 93 /* STGAPP snd :: (StgVar,[Arg]) */
303 #define STGPRIM 94 /* STGPRIM snd :: (PrimOp,[Arg]) */
304 #define STGCON 95 /* STGCON snd :: (StgCon,[Arg]) */
305 #define PRIMCASE 96 /* PRIMCASE snd :: (Expr,[PrimAlt]) */
306 #define DEEFALT 97 /* DEEFALT snd :: (Var,Expr) */
307 #define CASEALT 98 /* CASEALT snd :: (Con,[Var],Expr) */
308 #define PRIMALT 99 /* PRIMALT snd :: ([Var],Expr) */
312 Top-level interface entities
313 type Line = Int -- a line number
314 type ConVarId = CONIDCELL | VARIDCELL
316 type ExportListEntry = ConVarId | (ConId, <ConVarId>)
317 type Associativity = mkInt of LEFT_ASS | RIGHT_ASS | NON_ASS
318 type Constr = ((ConId, [((Type,VarId,Int))]))
319 ((constr name, [((type, field name if any, strictness))]))
320 strictness: 0 => none, 1 => !, 2 => !! (unpacked)
321 All 2/3/4/5 tuples in the interface abstract syntax are done with
325 #define I_INTERFACE 109 /* snd :: ((ConId, [I_IMPORT..I_VALUE]))
326 interface name, list of iface entities */
328 #define I_IMPORT 110 /* snd :: ((ConId, [ConVarId]))
329 module name, list of entities */
331 #define I_INSTIMPORT 111 /* snd :: NIL -- not used at present */
333 #define I_EXPORT 112 /* snd :: ((ConId, [ExportListEntry]))
334 this module name?, entities to export */
336 #define I_FIXDECL 113 /* snd :: ((NIL|Int, Associativity, ConVarId))
337 fixity, associativity, name */
339 #define I_INSTANCE 114 /* snd :: ((Line,
343 forall-y bit (eg __forall [a b] =>),
344 other bit, eg { C a1 } -> { C2 a2 } -> ... -> { Cn an },
345 name of dictionary builder,
346 (after startGHCInstance) the instance table location */
348 #define I_TYPE 115 /* snd :: ((Line, ConId, [((VarId,Kind))], Type))
349 lineno, tycon, kinded tyvars, the type expr */
351 #define I_DATA 116 /* snd :: ((Line, [((QConId,VarId))], ConId,
352 [((VarId,Kind))], [Constr])
353 lineno, context, tycon, kinded tyvars, constrs
354 An empty constr list means exported abstractly. */
356 #define I_NEWTYPE 117 /* snd :: ((Line, [((QConId,VarId))], ConId,
357 [((VarId,Kind))], ((ConId,Type)) ))
358 lineno, context, tycon, kinded tyvars, constr
359 constr==NIL means exported abstractly. */
361 #define I_CLASS 118 /* snd :: ((Line, [((QConId,VarId))], ConId,
362 [((VarId,Kind))], [((VarId,Type))]))
363 lineno, context, classname,
364 kinded tyvars, method sigs */
366 #define I_VALUE 119 /* snd :: ((Line, VarId, Type)) */
372 #define ZCONS 190 /* snd :: (Cell,Cell) */
376 #define ZTUP2 192 /* snd :: (Cell,Cell) */
377 #define ZTUP3 193 /* snd :: (Cell,(Cell,Cell)) */
378 #define ZTUP4 194 /* snd :: (Cell,(Cell,(Cell,Cell))) */
379 #define ZTUP5 195 /* snd :: (Cell,(Cell,(Cell,(Cell,Cell)))) */
381 /* Last constructor tag must be less than SPECMIN */
383 /* --------------------------------------------------------------------------
384 * Special cell values:
385 * ------------------------------------------------------------------------*/
390 #define isSpec(c) (SPECMIN<=(c) && (c)<EXTMIN)/* Special cell values */
392 #define isSpec(c) (SPECMIN<=(c) && (c)<OFFMIN)
395 #define NONE 201 /* Dummy stub */
396 #define STAR 202 /* Representing the kind of types */
398 #define ROW 203 /* Representing the kind of rows */
400 #define WILDCARD 204 /* Wildcard pattern */
401 #define SKOLEM 205 /* Skolem constant */
403 #define DOTDOT 206 /* ".." in import/export list */
405 #define NAME 210 /* whatIs code for isName */
406 #define TYCON 211 /* whatIs code for isTycon */
407 #define CLASS 212 /* whatIs code for isClass */
408 #define MODULE 213 /* whatIs code for isModule */
409 #define INSTANCE 214 /* whatIs code for isInst */
410 #define TUPLE 215 /* whatIs code for tuple constructor */
411 #define OFFSET 216 /* whatis code for offset */
412 #define AP 217 /* whatIs code for application node */
413 #define CHARCELL 218 /* whatIs code for isChar */
415 #define EXT 219 /* whatIs code for isExt */
418 #define SIGDECL 220 /* Signature declaration */
419 #define FIXDECL 221 /* Fixity declaration */
420 #define FUNBIND 222 /* Function binding */
421 #define PATBIND 223 /* Pattern binding */
423 #define DATATYPE 230 /* Datatype type constructor */
424 #define NEWTYPE 231 /* Newtype type constructor */
425 #define SYNONYM 232 /* Synonym type constructor */
426 #define RESTRICTSYN 233 /* Synonym with restricted scope */
428 #define NODEPENDS 235 /* Stop calculation of deps in type check*/
429 #define PREDEFINED 236 /* Predefined name, not yet filled */
431 /* --------------------------------------------------------------------------
432 * Tuple data/type constructors:
433 * ------------------------------------------------------------------------*/
435 extern Text ghcTupleText ( Tycon );
436 extern Text ghcTupleText_n ( Int );
442 #define isExt(c) (EXTMIN<=(c) && (c)<OFFMIN)
443 #define extText(e) tabExt[(e)-EXTMIN]
444 #define extField(c) arg(fun(c))
445 #define extRow(c) arg(c)
447 extern Text DECTABLE(tabExt);
448 extern Ext mkExt ( Text );
453 extern Module findFakeModule ( Text t );
454 extern Tycon addTupleTycon ( Int n );
455 extern Name addWiredInBoxingTycon
456 ( String modNm, String typeNm, String constrNm,
457 Int rep, Kind kind );
458 Tycon addWiredInEnumTycon ( String modNm, String typeNm,
459 List /*of Text*/ constrs );
461 /* --------------------------------------------------------------------------
462 * Offsets: (generic types/stack offsets)
463 * ------------------------------------------------------------------------*/
466 #define OFFMIN (EXTMIN+NUM_EXT)
470 #define isOffset(c) (OFFMIN<=(c) && (c)<MODMIN)
471 #define offsetOf(c) ((c)-OFFMIN)
472 #define mkOffset(o) (OFFMIN+(o))
475 /* --------------------------------------------------------------------------
477 * ------------------------------------------------------------------------*/
479 #define MODMIN (OFFMIN+NUM_OFFSETS)
481 #define isModule(c) (MODMIN<=(c) && (c)<TYCMIN)
482 #define mkModule(n) (MODMIN+(n))
483 #define module(n) tabModule[(n)-MODMIN]
485 /* Import defns for the ObjectCode struct in Module. */
488 /* Under Haskell 1.3, the list of qualified imports is always a subset
489 * of the list of unqualified imports. For simplicity and flexibility,
490 * we do not attempt to exploit this fact - when a module is imported
491 * unqualified, it is added to both the qualified and unqualified
493 * Similarily, Haskell 1.3 does not allow a constructor to be imported
494 * or exported without exporting the type it belongs to but the export
495 * list is just a flat list of Texts (before static analysis) or
496 * Tycons, Names and Classes (after static analysis).
500 /* Lists of top level objects (local defns + imports) */
504 List exports; /* [ Entity | (Entity, NIL|DOTDOT) ] */
505 /* List of qualified imports. Used both during compilation and when
506 * evaluating an expression in the context of the current module.
510 /* TRUE if module exists only via GHC primop defn; usually FALSE */
513 /* The primary object file for this module. */
516 /* And any extras it might need. */
517 ObjectCode* objectExtras;
518 List objectExtraNames; /* :: [Text] -- names of extras */
522 extern Module currentModule; /* Module currently being processed */
523 extern struct Module DECTABLE(tabModule);
525 extern Bool isValidModule ( Module );
526 extern Module newModule ( Text );
527 extern Module findModule ( Text );
528 extern Module findModid ( Cell );
529 extern Void setCurrModule ( Module );
531 extern void addOTabName ( Module,char*,void* );
532 extern void* lookupOTabName ( Module,char* );
533 extern char* nameFromOPtr ( void* );
535 extern void addSection ( Module,void*,void*,OSectionKind );
536 extern OSectionKind lookupSection ( void* );
537 extern void* lookupOExtraTabName ( char* sym );
539 #define isPrelude(m) (m==modulePrelude)
541 #define N_PRELUDE_SCRIPTS (combined ? 32 : 1)
543 /* --------------------------------------------------------------------------
544 * Type constructor names:
545 * ------------------------------------------------------------------------*/
547 #define TYCMIN (MODMIN+NUM_MODULE)
548 #define isTycon(c) (TYCMIN<=(c) && (c)<NAMEMIN && tabTycon[(c)-TYCMIN].tuple==-1)
549 #define tycon(n) tabTycon[(n)-TYCMIN]
551 #define isTuple(c) (TYCMIN<=(c) && (c)<NAMEMIN && tabTycon[(c)-TYCMIN].tuple>=0)
552 #define tupleOf(n) (tabTycon[(n)-TYCMIN].tuple)
553 extern Tycon mkTuple ( Int );
559 Module mod; /* module that defines it */
560 Int tuple; /* tuple number, or -1 if not tuple */
562 Kind kind; /* kind (includes arity) of Tycon */
563 Cell what; /* DATATYPE/SYNONYM/RESTRICTSYN... */
565 Name conToTag; /* used in derived code */
567 void* itbl; /* For tuples, the info tbl pointer */
571 extern struct strTycon DECTABLE(tabTycon);
573 extern Tycon newTycon ( Text );
574 extern Tycon findTycon ( Text );
575 extern Tycon addTycon ( Tycon );
576 extern Tycon findQualTycon ( Cell );
577 extern Tycon addPrimTycon ( Text,Kind,Int,Cell,Cell );
579 #define isSynonym(h) (isTycon(h) && tycon(h).what==SYNONYM)
580 #define isQualType(t) (isPair(t) && fst(t)==QUAL)
581 #define mkPolyType(n,t) pair(POLYTYPE,pair(n,t))
582 #define isPolyType(t) (isPair(t) && fst(t)==POLYTYPE)
583 #define isPolyOrQualType(t) (isPair(t) && (fst(t)==POLYTYPE || fst(t)==QUAL))
584 #define polySigOf(t) fst(snd(t))
585 #define monotypeOf(t) snd(snd(t))
587 #define bang(t) ap(BANG,t)
588 extern Tycon findQualTyconWithoutConsultingExportList ( QualId q );
590 /* --------------------------------------------------------------------------
591 * Globally defined name values:
592 * ------------------------------------------------------------------------*/
594 #define NAMEMIN (TYCMIN+NUM_TYCON)
595 #define isName(c) (NAMEMIN<=(c) && (c)<INSTMIN)
596 #define mkName(n) (NAMEMIN+(n))
597 #define name(n) tabName[(n)-NAMEMIN]
602 Module mod; /* module that defines it */
609 Cell stgVar; /* really StgVar */
610 Text callconv; /* for foreign import/export */
611 void* primop; /* really StgPrim* */
612 void* itbl; /* For constructors, the info tbl pointer */
616 extern int numNames ( Void );
618 extern struct strName DECTABLE(tabName);
620 /* The number field in a name is used to distinguish various kinds of name:
621 * mfunNo(i) = code for member function, offset i
622 * members that are sole elements of dict use mfunNo(0)
623 * members of dicts with more than one elem use mfunNo(n), n>=1
624 * EXECNAME = code for executable name (bytecodes or primitive)
625 * SELNAME = code for selector function
626 * DFUNNAME = code for dictionary builder or selector
627 * cfunNo(i) = code for data constructor
628 * datatypes with only one constructor uses cfunNo(0)
629 * datatypes with multiple constructors use cfunNo(n), n>=1
637 #define isSfun(n) (name(n).number==SELNAME)
638 #define isDfun(n) (name(n).number==DFUNNAME)
640 #define isCfun(n) (name(n).number>=CFUNNAME)
641 #define cfunOf(n) (name(n).number-CFUNNAME)
642 #define cfunNo(i) ((i)+CFUNNAME)
643 #define hasCfun(cs) (nonNull(cs) && isCfun(hd(cs)))
645 #define isMfun(n) (name(n).number<0)
646 #define mfunOf(n) ((-1)-name(n).number)
647 #define mfunNo(i) ((-1)-(i))
649 extern Name newName ( Text,Cell );
650 extern Name findName ( Text );
651 extern Name addName ( Name );
652 extern Name findQualName ( Cell );
653 extern Name addPrimCfun ( Text,Int,Int,Cell );
654 extern Name addPrimCfunREP ( Text,Int,Int,Int );
655 extern Int sfunPos ( Name,Name );
656 extern Name nameFromStgVar ( Cell );
657 extern Name jrsFindQualName ( Text,Text );
659 extern Name findQualNameWithoutConsultingExportList ( QualId q );
661 /* --------------------------------------------------------------------------
663 * ------------------------------------------------------------------------*/
665 #define INSTMIN (NAMEMIN+NUM_NAME) /* instances */
666 #define isInst(c) (INSTMIN<=(c) && (c)<CLASSMIN)
667 #define mkInst(n) (INSTMIN+(n))
668 #define instOf(c) ((Int)((c)-INSTMIN))
669 #define inst(in) tabInst[(in)-INSTMIN]
672 Class c; /* class C */
674 Module mod; /* module that defines it */
675 Kinds kinds; /* Kinds of variables in head */
676 Cell head; /* :: Pred */
677 List specifics; /* :: [Pred] */
678 Int numSpecifics; /* length(specifics) */
680 Name builder; /* Dictionary constructor function */
683 /* a predicate (an element :: Pred) is an application of a Class to one or
684 * more type expressions
687 #define CLASSMIN (INSTMIN+NUM_INSTS)
688 #define isClass(c) (CLASSMIN<=(c) && (c)<CHARMIN)
689 #define mkClass(n) (CLASSMIN+(n))
690 #define cclass(n) tabClass[(n)-CLASSMIN]
693 Text text; /* Name of class */
694 Int line; /* Line where declaration begins */
695 Module mod; /* module that declares it */
696 Int level; /* Level in class hierarchy */
697 Int arity; /* Number of arguments */
698 Kinds kinds; /* Kinds of constructors in class */
699 List fds; /* Functional Dependencies */
700 List xfds; /* Xpanded Functional Dependencies */
701 Cell head; /* Head of class */
702 Name dcon; /* Dictionary constructor function */
703 List supers; /* :: [Pred] */
704 Int numSupers; /* length(supers) */
705 List dsels; /* Superclass dictionary selectors */
706 List members; /* :: [Name] */
707 Int numMembers; /* length(members) */
708 List defaults; /* :: [Name] */
709 List instances; /* :: [Inst] */
712 extern struct strClass DECTABLE(tabClass);
713 extern struct strInst far *tabInst;
715 extern Class newClass ( Text );
716 extern Class classMax ( Void );
717 extern Class findClass ( Text );
718 extern Class addClass ( Class );
719 extern Class findQualClass ( Cell );
720 extern Inst newInst ( Void );
721 extern Inst findFirstInst ( Tycon );
722 extern Inst findNextInst ( Tycon,Inst );
723 extern List getAllKnownTyconsAndClasses ( void );
724 extern Class findQualClassWithoutConsultingExportList ( QualId q );
726 /* --------------------------------------------------------------------------
728 * ------------------------------------------------------------------------*/
730 #define CHARMIN (CLASSMIN+NUM_CLASSES)
731 #define MAXCHARVAL (NUM_CHARS-1)
732 #define isChar(c) (CHARMIN<=(c) && (c)<INTMIN)
733 #define charOf(c) ((Char)(c-CHARMIN))
734 #define mkChar(c) ((Cell)(CHARMIN+(((unsigned)(c))%NUM_CHARS)))
736 /* --------------------------------------------------------------------------
737 * Small Integer values:
738 * ------------------------------------------------------------------------*/
740 #define INTMIN (CHARMIN+NUM_CHARS)
741 #define INTMAX (MAXPOSINT)
742 #define isSmall(c) (INTMIN<=(c))
743 #define INTZERO (INTMIN/2 + INTMAX/2)
744 #define MINSMALLINT (INTMIN - INTZERO)
745 #define MAXSMALLINT (INTMAX - INTZERO)
746 #define mkDigit(c) ((Cell)((c)+INTMIN))
747 #define digitOf(c) ((Int)((c)-INTMIN))
749 extern Bool isInt ( Cell );
750 extern Int intOf ( Cell );
751 extern Cell mkInt ( Int );
753 /* --------------------------------------------------------------------------
754 * Implementation of triples:
755 * ------------------------------------------------------------------------*/
757 #define triple(x,y,z) pair(x,pair(y,z))
758 #define fst3(c) fst(c)
759 #define snd3(c) fst(snd(c))
760 #define thd3(c) snd(snd(c))
762 /* --------------------------------------------------------------------------
763 * Implementation of lists:
764 * ------------------------------------------------------------------------*/
767 #define isNull(c) ((c)==NIL)
768 #define nonNull(c) (c)
769 #define cons(x,xs) pair(x,xs)
770 #define singleton(x) cons(x,NIL)
771 #define doubleton(x,y) cons(x,cons(y,NIL))
772 #define tripleton(x,y,z) cons(x,cons(y,cons(z,NIL)))
776 extern Int length ( List );
777 extern List appendOnto ( List,List ); /* destructive */
778 extern List dupOnto ( List,List );
779 extern List dupList ( List );
780 extern List revOnto ( List, List ); /* destructive */
781 #define rev(xs) revOnto((xs),NIL) /* destructive */
782 #define reverse(xs) revOnto(dupList(xs),NIL) /* non-destructive */
783 extern Cell cellIsMember ( Cell,List );
784 extern Cell cellAssoc ( Cell,List );
785 extern Cell cellRevAssoc ( Cell,List );
786 extern Bool eqList ( List,List );
787 extern Cell varIsMember ( Text,List );
788 extern Name nameIsMember ( Text,List );
789 extern QualId qualidIsMember ( QualId, List );
790 extern Cell intIsMember ( Int,List );
791 extern List replicate ( Int,Cell );
792 extern List diffList ( List,List ); /* destructive */
793 extern List deleteCell ( List,Cell ); /* non-destructive */
794 extern List take ( Int,List ); /* destructive */
795 extern List splitAt ( Int,List ); /* non-destructive */
796 extern Cell nth ( Int,List );
797 extern List removeCell ( Cell,List ); /* destructive */
798 extern List dupListOnto ( List,List ); /* non-destructive */
799 extern List nubList ( List ); /* non-destructive */
801 /* The following macros provide `inline expansion' of some common ways of
802 * traversing, using and modifying lists:
804 * N.B. We use the names _f, _a, _xs, Zs, in an attempt to avoid clashes
805 * with identifiers used elsewhere.
808 #define mapBasic(_init,_step) {List Zs=(_init);\
809 for(;nonNull(Zs);Zs=tl(Zs)) \
811 #define mapModify(_init,_step) mapBasic(_init,hd(Zs)=_step)
813 #define mapProc(_f,_xs) mapBasic(_xs,_f(hd(Zs)))
814 #define map1Proc(_f,_a,_xs) mapBasic(_xs,_f(_a,hd(Zs)))
815 #define map2Proc(_f,_a,_b,_xs) mapBasic(_xs,_f(_a,_b,hd(Zs)))
816 #define map3Proc(_f,_a,_b,_c,_xs) mapBasic(_xs,_f(_a,_b,_c,hd(Zs)))
817 #define map4Proc(_f,_a,_b,_c,_d,_xs) mapBasic(_xs,_f(_a,_b,_c,_d,hd(Zs)))
819 #define mapOver(_f,_xs) mapModify(_xs,_f(hd(Zs)))
820 #define map1Over(_f,_a,_xs) mapModify(_xs,_f(_a,hd(Zs)))
821 #define map2Over(_f,_a,_b,_xs) mapModify(_xs,_f(_a,_b,hd(Zs)))
822 #define map3Over(_f,_a,_b,_c,_xs) mapModify(_xs,_f(_a,_b,_c,hd(Zs)))
823 #define map4Over(_f,_a,_b,_c,_d,_xs) mapModify(_xs,_f(_a,_b,_c,_d,hd(Zs)))
825 /* This is just what you want for functions with accumulating parameters */
826 #define mapAccum(_f,_acc,_xs) mapBasic(_xs,_acc=_f(_acc,hd(Zs)))
827 #define map1Accum(_f,_acc,_a,_xs) mapBasic(_xs,_acc=_f(_acc,_a,hd(Zs)))
828 #define map2Accum(_f,_acc,_a,_b,_xs) mapBasic(_xs,_acc=_f(_acc,_a,_b,hd(Zs)))
829 #define map3Accum(_f,_acc,_a,_b,_c,_xs) mapBasic(_xs,_acc=_f(_acc,_a,_b,_c,hd(Zs)))
832 /* --------------------------------------------------------------------------
833 * Strongly-typed lists (z-lists) and tuples (experimental)
834 * ------------------------------------------------------------------------*/
837 typedef Cell ZTriple;
843 extern Cell zcons ( Cell x, Cell xs );
844 extern Cell zhd ( Cell xs );
845 extern Cell ztl ( Cell xs );
846 extern Cell zsingleton ( Cell x );
847 extern Cell zdoubleton ( Cell x, Cell y );
848 extern Int zlength ( ZList xs );
849 extern ZList zreverse ( ZList xs );
852 extern Cell zpair ( Cell x1, Cell x2 );
853 extern Cell zfst ( Cell zpair );
854 extern Cell zsnd ( Cell zpair );
856 extern Cell ztriple ( Cell x1, Cell x2, Cell x3 );
857 extern Cell zfst3 ( Cell zpair );
858 extern Cell zsnd3 ( Cell zpair );
859 extern Cell zthd3 ( Cell zpair );
861 extern Cell z4ble ( Cell x1, Cell x2, Cell x3, Cell x4 );
862 extern Cell zsel14 ( Cell zpair );
863 extern Cell zsel24 ( Cell zpair );
864 extern Cell zsel34 ( Cell zpair );
865 extern Cell zsel44 ( Cell zpair );
867 extern Cell z5ble ( Cell x1, Cell x2, Cell x3, Cell x4, Cell x5 );
868 extern Cell zsel15 ( Cell zpair );
869 extern Cell zsel25 ( Cell zpair );
870 extern Cell zsel35 ( Cell zpair );
871 extern Cell zsel45 ( Cell zpair );
872 extern Cell zsel55 ( Cell zpair );
874 extern Cell unap ( int tag, Cell c );
875 #define isZPair(c) (whatIs((c))==ZTUP2)
877 /* --------------------------------------------------------------------------
878 * Implementation of function application nodes:
879 * ------------------------------------------------------------------------*/
881 #define ap(f,x) pair(f,x)
882 #define ap1(f,x) ap(f,x)
883 #define ap2(f,x,y) ap(ap(f,x),y)
884 #define ap3(f,x,y,z) ap(ap(ap(f,x),y),z)
885 #define fun(c) fst(c)
886 #define arg(c) snd(c)
887 #define isAp(c) (isPair(c) && !isTag(fst(c)))
888 extern Cell getHead ( Cell );
889 extern List getArgs ( Cell );
891 extern Cell nthArg ( Int,Cell );
892 extern Int numArgs ( Cell );
893 extern Cell applyToArgs ( Cell,List );
895 /* --------------------------------------------------------------------------
896 * Stack implementation:
898 * NB: Use of macros makes order of evaluation hard to predict.
899 * For example, "push(1+pop());" doesn't increment TOS.
900 * ------------------------------------------------------------------------*/
902 extern Cell DECTABLE(cellStack);
905 #define clearStack() sp=(-1)
906 #define stackEmpty() (sp==(-1))
907 #define stack(p) cellStack[p]
908 #define chkStack(n) if (sp>=NUM_STACK-(n)) hugsStackOverflow()
914 #define onto(c) stack(++sp)=(c);
915 #define pop() stack(sp--)
917 #define top() stack(sp)
918 #define pushed(n) stack(sp-(n))
919 #define topfun(f) top()=ap((f),top())
920 #define toparg(x) top()=ap(top(),(x))
922 extern Void hugsStackOverflow ( Void );
926 #define STACK_HEADROOM 16384
927 #define STACK_CHECK if (StackSpace() <= STACK_HEADROOM) \
928 internal("Macintosh function parameter stack overflow.");
933 /* --------------------------------------------------------------------------
934 * Script file control:
935 * The implementation of script file storage is hidden.
936 * ------------------------------------------------------------------------*/
938 extern Script startNewScript ( String );
939 extern Bool moduleThisScript ( Module );
940 extern Module moduleOfScript ( Script );
941 extern Bool isPreludeScript ( Void );
942 extern Module lastModule ( Void );
943 extern Script scriptThisFile ( Text );
944 extern Script scriptThisName ( Name );
945 extern Script scriptThisTycon ( Tycon );
946 extern Script scriptThisInst ( Inst );
947 extern Script scriptThisClass ( Class );
948 extern String fileOfModule ( Module );
949 extern Void dropScriptsFrom ( Script );
952 /* --------------------------------------------------------------------------
954 * ------------------------------------------------------------------------*/
956 extern Void setLastExpr ( Cell );
957 extern Cell getLastExpr ( Void );
958 extern List addTyconsMatching ( String,List );
959 extern List addNamesMatching ( String,List );
961 extern Tycon findTyconInAnyModule ( Text t );
962 extern Class findClassInAnyModule ( Text t );
963 extern Name findNameInAnyModule ( Text t );
965 extern Void print ( Cell, Int );
966 extern void dumpTycon ( Int t );
967 extern void dumpName ( Int n );
968 extern void dumpClass ( Int c );
969 extern void dumpInst ( Int i );
970 extern void locateSymbolByName ( Text t );
972 /*-------------------------------------------------------------------------*/