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/04/27 16:35:29 $
15 * ------------------------------------------------------------------------*/
17 #define DEBUG_STORAGE /* a moderate level of sanity checking */
18 #define DEBUG_STORAGE_EXTRA /* max paranoia in sanity checks */
20 /* --------------------------------------------------------------------------
21 * Typedefs for main data types:
22 * Many of these type names are used to indicate the intended us of a data
23 * item, rather than for type checking purposes. Sadly (although sometimes,
24 * fortunately), the C compiler cannot distinguish between the use of two
25 * different names defined to be synonyms for the same types.
26 * ------------------------------------------------------------------------*/
28 typedef Int Text; /* text string */
29 typedef Unsigned Syntax; /* syntax (assoc,preced) */
30 typedef Int Cell; /* general cell value */
31 typedef Cell far *Heap; /* storage of heap */
32 typedef Cell Pair; /* pair cell */
33 typedef Int StackPtr; /* stack pointer */
34 typedef Cell Offset; /* offset/generic variable*/
35 typedef Int Module; /* module */
36 typedef Cell Tycon; /* type constructor */
37 typedef Cell Type; /* type expression */
38 typedef Cell Kind; /* kind expression */
39 typedef Cell Kinds; /* list of kinds */
40 typedef Cell Constr; /* constructor expression */
41 typedef Cell Name; /* named value */
42 typedef Cell Class; /* type class */
43 typedef Cell Inst; /* instance of type class */
44 typedef Cell Triple; /* triple of cell values */
45 typedef Cell List; /* list of cells */
46 typedef Cell Bignum; /* bignum integer */
47 typedef Cell Float; /* floating pt literal */
49 typedef Cell Ext; /* extension label */
55 typedef Cell ConVarId;
57 /* --------------------------------------------------------------------------
60 * -heapSize .. -1 cells in the heap
63 * TAG_NONPTR_MIN(100) .. TAG_NONPTR_MAX(116) non pointer tags
64 * TAG_PTR_MIN(200) .. TAG_PTR_MAX(298) pointer tags
65 * TAG_SPEC_MIN(400) .. TAG_SPEC_MAX(431) special tags
66 * OFF_MIN(1,000) .. OFF_MAX(1,999) offsets
67 * CHARR_MIN(3,000) .. CHARR_MAX(3,255) chars
69 * SMALL_INT_MIN(100,000) .. SMALL_INT_MAX(499,999) smallish ints
72 * NAME_BASE_ADDR (1,000,000 .. 1,899,999) names
73 * TYCON_BASE_ADDR (2,000,000 .. 2,899,999) tycons
74 * CCLASS_BASE_ADDR (3,000,000 .. 3,899,999) classes
75 * INST_BASE_ADDR (4,000,000 .. 4,899,999) instances
76 * MODULE_BASE_ADDR (5,000,000 .. 5,899,999) modules
77 * INVAR_BASE_ADDR (6,000,000 .. 6,899,999) invented var names
78 * INDVAR_BASE_ADDR (7,000,000 .. 7,899,999) invented dict var names
79 * TEXT_BASE_ADDR (8,000,000 .. 8M +TEXT_SIZE-1) text
80 * ------------------------------------------------------------------------*/
82 /* --------------------------------------------------------------------------
84 * provides storage for the characters making up identifier and symbol
85 * names, string literals, character constants etc...
86 * ------------------------------------------------------------------------*/
88 extern String textToStr ( Text );
89 extern Text findText ( String );
90 extern Text inventText ( Void );
91 extern Text inventDictText ( Void );
92 extern Bool inventedText ( Text );
93 extern Text enZcodeThenFindText ( String );
94 extern Text unZcodeThenFindText ( String );
96 /* Variants of textToStr and syntaxOf which work for idents, ops whether
97 * qualified or unqualified.
99 extern String identToStr ( Cell );
100 extern Text fixLitText ( Text );
101 extern Syntax identSyntax ( Cell );
102 extern Syntax defaultSyntax ( Text );
104 #define INVAR_BASE_ADDR 6000000
105 #define INVAR_MAX_AVAIL 900000
106 #define isInventedVar(c) (INVAR_BASE_ADDR<=(c) \
107 && (c)<INVAR_BASE_ADDR+INVAR_MAX_AVAIL)
109 #define INDVAR_BASE_ADDR 7000000
110 #define INDVAR_MAX_AVAIL 900000
111 #define isInventedDictVar(c) (INDVAR_BASE_ADDR<=(c) \
112 && (c)<INDVAR_BASE_ADDR+INDVAR_MAX_AVAIL)
114 #define TEXT_BASE_ADDR 8000000
115 #define isText(c) (TEXT_BASE_ADDR<=(c) \
116 && (c)<TEXT_BASE_ADDR+TEXT_SIZE)
118 /* --------------------------------------------------------------------------
119 * Specification of syntax (i.e. default written form of application)
120 * ------------------------------------------------------------------------*/
122 #define MIN_PREC 0 /* weakest binding operator */
123 #define MAX_PREC 9 /* strongest binding operator */
124 #define FUN_PREC (MAX_PREC+2) /* binding of function symbols */
125 #define DEF_PREC MAX_PREC
126 #define APPLIC 0 /* written applicatively */
127 #define LEFT_ASS 1 /* left associative infix */
128 #define RIGHT_ASS 2 /* right associative infix */
129 #define NON_ASS 3 /* non associative infix */
130 #define DEF_ASS LEFT_ASS
132 #define UMINUS_PREC 6 /* Change these settings at your */
133 #define UMINUS_ASSOC LEFT_ASS /* own risk; they may not work! */
135 #define assocOf(x) ((x)&NON_ASS)
136 #define precOf(x) ((x)>>2)
137 #define mkSyntax(a,p) ((a)|((p)<<2))
138 #define DEF_OPSYNTAX mkSyntax(DEF_ASS,DEF_PREC)
139 #define NO_SYNTAX (-1)
141 extern Void addSyntax ( Int,Text,Syntax );
142 extern Syntax syntaxOf ( Text );
144 /* --------------------------------------------------------------------------
146 * Provides a garbage collectable heap for storage of expressions etc.
147 * ------------------------------------------------------------------------*/
149 #define heapAlloc(s) (Heap)(farCalloc(s,sizeof(Cell)))
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 */
158 #define fst(c) heapTopFst[c]
159 #define snd(c) heapTopSnd[c]
161 extern Pair pair ( Cell,Cell );
162 extern Void garbageCollect ( Void );
163 extern Void mark ( Cell );
165 #define isPair(c) ((c)<0)
166 #define isGenPair(c) ((c)<0 && -heapSize<=(c))
168 extern Cell whatIs ( Cell );
170 /* --------------------------------------------------------------------------
171 * Pairs in the heap fall into three categories.
174 * used to denote that the second element of the pair is to be treated
175 * in some special way (eg is a integer or Text), and specifically is not
179 * to indicate that the second element of the pair is a normal
180 * heap pointer, which should be followed at GC time
183 * is a genuine pair, where both components are heap pointers.
184 * ------------------------------------------------------------------------*/
186 #if !defined(SIZEOF_VOID_P) || !defined(SIZEOF_INT)
187 #error SIZEOF_VOID_P or SIZEOF_INT is not defined
190 #define isTagNonPtr(c) (TAG_NONPTR_MIN<=(c) && (c)<=TAG_NONPTR_MAX)
191 #define isTagPtr(c) (TAG_PTR_MIN<=(c) && (c)<=TAG_PTR_MAX)
192 #define isTag(c) (isTagNonPtr(c) || isTagPtr(c))
194 /* --------------------------------------------------------------------------
195 * Tags for non-pointer cells.
196 * ------------------------------------------------------------------------*/
198 #define TAG_NONPTR_MIN 100
199 #define TAG_NONPTR_MAX 116
201 #define FREECELL 100 /* Free list cell: snd :: Cell */
202 #define VARIDCELL 101 /* Identifier variable: snd :: Text */
203 #define VAROPCELL 102 /* Operator variable: snd :: Text */
204 #define DICTVAR 103 /* Dictionary variable: snd :: Text */
205 #define CONIDCELL 104 /* Identifier constructor: snd :: Text */
206 #define CONOPCELL 105 /* Operator constructor: snd :: Text */
207 #define STRCELL 106 /* String literal: snd :: Text */
208 #define INTCELL 107 /* Int literal: snd :: Int */
209 #define ADDPAT 108 /* (_+k) pattern discr: snd :: Int */
210 #define FLOATCELL 109 /* Floating Pt literal: snd :: Text */
211 #define BIGCELL 110 /* Integer literal: snd :: Text */
212 #define ADDRCELL 111 /* Address literal snd :: Ptr */
213 #define MPTRCELL 112 /* C (malloc) Heap Pointer snd :: Ptr */
214 #define CPTRCELL 113 /* Closure pointer snd :: Ptr */
217 #define IPCELL 114 /* Imp Param Cell: snd :: Text */
218 #define IPVAR 115 /* ?x: snd :: Text */
222 #define EXTCOPY 116 /* Copy of an Ext: snd :: Text */
225 #define qmodOf(c) (textOf(fst(snd(c)))) /* c :: QUALIDENT */
226 #define qtextOf(c) (textOf(snd(snd(c)))) /* c :: QUALIDENT */
227 #define mkVar(t) ap(VARIDCELL,t)
228 #define mkVarop(t) ap(VAROPCELL,t)
229 #define mkCon(t) ap(CONIDCELL,t)
230 #define mkConop(t) ap(CONOPCELL,t)
231 #define mkQVar(m,t) ap(QUALIDENT,pair(mkCon(m),mkVar(t)))
232 #define mkQCon(m,t) ap(QUALIDENT,pair(mkCon(m),mkCon(t)))
233 #define mkQVarOp(m,t) ap(QUALIDENT,pair(mkCon(m),mkVarop(t)))
234 #define mkQConOp(m,t) ap(QUALIDENT,pair(mkCon(m),mkConop(t)))
235 #define mkQualId(m,t) ap(QUALIDENT,pair(m,t))
236 #define intValOf(c) (snd(c))
237 #define inventVar() mkVar(inventText())
238 #define mkDictVar(t) ap(DICTVAR,t)
239 #define inventDictVar() mkDictVar(inventDictText())
240 #define mkStr(t) ap(STRCELL,t)
242 #define mkIParam(c) ap(IPCELL,snd(c))
243 #define isIP(p) (whatIs(p) == IPCELL)
244 #define ipMatch(pi, t) (isIP(fun(pi)) && textOf(fun(pi)) == t)
245 #define ipVar(pi) textOf(fun(pi))
247 #define isIP(p) FALSE
250 extern Bool isVar ( Cell );
251 extern Bool isCon ( Cell );
252 extern Bool isQVar ( Cell );
253 extern Bool isQCon ( Cell );
254 extern Bool isQualIdent ( Cell );
255 extern Bool eqQualIdent ( QualId c1, QualId c2 );
256 extern Bool isIdent ( Cell );
257 extern String stringNegate ( String );
258 extern Text textOf ( Cell );
260 #define isFloat(c) (isPair(c) && fst(c)==FLOATCELL)
261 #define stringToFloat(s) pair(FLOATCELL,findText(s))
262 #define floatToString(f) textToStr(snd(f))
263 #define floatOf(f) atof(floatToString(f))
264 #define mkFloat(f) (f) /* ToDo: is this right? */
265 #define floatNegate(f) stringToFloat(stringNegate(floatToString(f)))
267 #define stringToBignum(s) pair(BIGCELL,findText(s))
268 #define bignumToString(b) textToStr(snd(b))
270 #define isMPtr(c) (isPair(c) && fst(c)==MPTRCELL)
271 extern Cell mkMPtr ( Ptr );
272 extern Ptr mptrOf ( Cell );
273 #define isCPtr(c) (isPair(c) && fst(c)==CPTRCELL)
274 extern Cell mkCPtr ( Ptr );
275 extern Ptr cptrOf ( Cell );
276 #define isAddr(c) (isPair(c) && fst(c)==ADDRCELL)
277 extern Cell mkAddr ( Ptr );
278 extern Ptr addrOf ( Cell );
280 /* --------------------------------------------------------------------------
281 * Tags for pointer cells.
282 * ------------------------------------------------------------------------*/
284 #define TAG_PTR_MIN 200
285 #define TAG_PTR_MAX 299
287 #define LETREC 200 /* LETREC snd :: ([Decl],Exp) */
288 #define COND 201 /* COND snd :: (Exp,Exp,Exp) */
289 #define LAMBDA 202 /* LAMBDA snd :: Alt */
290 #define FINLIST 203 /* FINLIST snd :: [Exp] */
291 #define DOCOMP 204 /* DOCOMP snd :: (Exp,[Qual]) */
292 #define BANG 205 /* BANG snd :: Type */
293 #define COMP 206 /* COMP snd :: (Exp,[Qual]) */
294 #define ASPAT 207 /* ASPAT snd :: (Var,Exp) */
295 #define ESIGN 208 /* ESIGN snd :: (Exp,Type) */
296 #define RSIGN 209 /* RSIGN snd :: (Rhs,Type) */
297 #define CASE 210 /* CASE snd :: (Exp,[Alt]) */
298 #define NUMCASE 211 /* NUMCASE snd :: (Exp,Disc,Rhs) */
299 #define FATBAR 212 /* FATBAR snd :: (Exp,Exp) */
300 #define LAZYPAT 213 /* LAZYPAT snd :: Exp */
301 #define DERIVE 214 /* DERIVE snd :: Cell */
302 #define BOOLQUAL 215 /* BOOLQUAL snd :: Exp */
303 #define QWHERE 216 /* QWHERE snd :: [Decl] */
304 #define FROMQUAL 217 /* FROMQUAL snd :: (Exp,Exp) */
305 #define DOQUAL 218 /* DOQUAL snd :: Exp */
306 #define MONADCOMP 219 /* MONADCOMP snd :: ((m,m0),(Exp,[Qual])*/
307 #define GUARDED 220 /* GUARDED snd :: [guarded exprs] */
308 #define ARRAY 221 /* Array snd :: (Bounds,[Values]) */
309 #define MUTVAR 222 /* Mutvar snd :: Cell */
310 #define HUGSOBJECT 223 /* HUGSOBJECT snd :: Cell */
313 #define WITHEXP 224 /* WITHEXP snd :: [(Var,Exp)] */
316 #define POLYTYPE 225 /* POLYTYPE snd :: (Kind,Type) */
317 #define QUAL 226 /* QUAL snd :: ([Classes],Type) */
318 #define RANK2 227 /* RANK2 snd :: (Int,Type) */
319 #define EXIST 228 /* EXIST snd :: (Int,Type) */
320 #define POLYREC 229 /* POLYREC snd :: (Int,Type) */
321 #define BIGLAM 230 /* BIGLAM snd :: (vars,patterns) */
322 #define CDICTS 231 /* CDICTS snd :: ([Pred],Type) */
324 #define LABC 232 /* LABC snd :: (con,[(Vars,Type)]) */
325 #define CONFLDS 233 /* CONFLDS snd :: (con,[Field]) */
326 #define UPDFLDS 234 /* UPDFLDS snd :: (Exp,[con],[Field]) */
328 #define RECORD 235 /* RECORD snd :: [Val] */
329 #define EXTCASE 236 /* EXTCASE snd :: (Exp,Disc,Rhs) */
330 #define RECSEL 237 /* RECSEL snd :: Ext */
332 #define IMPDEPS 238 /* IMPDEPS snd :: [Binding] */
334 #define QUALIDENT 239 /* Qualified identifier snd :: (Id,Id) */
335 #define HIDDEN 240 /* hiding import list snd :: [Entity] */
336 #define MODULEENT 241 /* module in export list snd :: con */
338 #define INFIX 242 /* INFIX snd :: (see tidyInfix) */
339 #define ONLY 243 /* ONLY snd :: Exp */
340 #define NEG 244 /* NEG snd :: Exp */
342 /* Used when parsing GHC interface files */
343 #define DICTAP 245 /* DICTAP snd :: (QClassId,[Type]) */
344 #define UNBOXEDTUP 246 /* UNBOXEDTUP snd :: [Type] */
346 #if SIZEOF_VOID_P != SIZEOF_INT
347 #define PTRCELL 247 /* C Heap Pointer snd :: (Int,Int) */
351 #define STGVAR 248 /* STGVAR snd :: (StgRhs,info) */
352 #define STGAPP 249 /* STGAPP snd :: (StgVar,[Arg]) */
353 #define STGPRIM 250 /* STGPRIM snd :: (PrimOp,[Arg]) */
354 #define STGCON 251 /* STGCON snd :: (StgCon,[Arg]) */
355 #define PRIMCASE 252 /* PRIMCASE snd :: (Expr,[PrimAlt]) */
356 #define DEEFALT 253 /* DEEFALT snd :: (Var,Expr) */
357 #define CASEALT 254 /* CASEALT snd :: (Con,[Var],Expr) */
358 #define PRIMALT 255 /* PRIMALT snd :: ([Var],Expr) */
361 #define GRP_REC 256 /* GRP_REC snd :: [CONID] */
362 #define GRP_NONREC 257 /* GRP_NONREC snd :: CONID */
366 Top-level interface entities
367 type Line = Int -- a line number
368 type ConVarId = CONIDCELL | VARIDCELL
369 type ExportListEntry = ConVarId | (ConId, [ConVarId])
370 type Associativity = mkInt of LEFT_ASS | RIGHT_ASS | NON_ASS
371 type Constr = ((ConId, [((Type,VarId,Int))]))
372 ((constr name, [((type, field name if any, strictness))]))
373 strictness: 0 => none, 1 => !, 2 => !! (unpacked)
374 All 2/3/4/5 tuples in the interface abstract syntax are done with
378 #define I_INTERFACE 260 /* snd :: ((ConId, [I_IMPORT..I_VALUE]))
379 interface name, list of iface entities */
381 #define I_IMPORT 261 /* snd :: ((ConId, [ConVarId]))
382 module name, list of entities */
384 #define I_INSTIMPORT 262 /* snd :: NIL -- not used at present */
386 #define I_EXPORT 263 /* snd :: ((ConId, [ExportListEntry]))
387 this module name?, entities to export */
389 #define I_FIXDECL 264 /* snd :: ((NIL|Int, Associativity, ConVarId))
390 fixity, associativity, name */
392 #define I_INSTANCE 265 /* snd :: ((Line,
396 forall-y bit (eg __forall [a b] =>),
397 other bit, eg { C a1 } -> { C2 a2 } -> ... -> { Cn an },
398 name of dictionary builder,
399 (after startGHCInstance) the instance table location */
401 #define I_TYPE 266 /* snd :: ((Line, ConId, [((VarId,Kind))], Type))
402 lineno, tycon, kinded tyvars, the type expr */
404 #define I_DATA 267 /* snd :: ((Line, [((QConId,VarId))], ConId,
405 [((VarId,Kind))], [Constr])
406 lineno, context, tycon, kinded tyvars, constrs
407 An empty constr list means exported abstractly. */
409 #define I_NEWTYPE 268 /* snd :: ((Line, [((QConId,VarId))], ConId,
410 [((VarId,Kind))], ((ConId,Type)) ))
411 lineno, context, tycon, kinded tyvars, constr
412 constr==NIL means exported abstractly. */
414 #define I_CLASS 269 /* snd :: ((Line, [((QConId,VarId))], ConId,
415 [((VarId,Kind))], [((VarId,Type))]))
416 lineno, context, classname,
417 kinded tyvars, method sigs */
419 #define I_VALUE 270 /* snd :: ((Line, VarId, Type)) */
422 Top-level module entities.
426 #define M_MODULE 280 /* snd :: ((ConId, [Export],
427 M_IMPORT_Q .. M_VALUE]))
428 module name, export spec, top level entities */
430 #define M_IMPORT_Q 281 /* snd :: ((?,?)) */
431 #define M_IMPORT_UNQ 282 /* snd :: ((?,?)) */
432 #define M_TYCON 283 /* snd :: ((Line,?,?,?)) */
433 #define M_CLASS 284 /* snd :: ((Line,?,?,?)) */
434 #define M_INST 285 /* snd :: ((Line,?,?)) */
435 #define M_DEFAULT 286 /* snd :: ((Line,?)) */
436 #define M_FOREIGN_EX 289 /* snd :: ((Line,?,?,?,?)) */
437 #define M_FOREIGN_IM 290 /* snd :: ((Line,?,?,?,?)) */
438 #define M_VALUE 291 /* snd :: ? */
446 #define ZTUP2 295 /* snd :: (Cell,Cell) */
447 #define ZTUP3 296 /* snd :: (Cell,(Cell,Cell)) */
448 #define ZTUP4 297 /* snd :: (Cell,(Cell,(Cell,Cell))) */
449 #define ZTUP5 298 /* snd :: (Cell,(Cell,(Cell,(Cell,Cell)))) */
451 #define MDOCOMP 299 /* MDOCOMP snd :: (Exp,[Qual]) */
454 /* --------------------------------------------------------------------------
455 * Special cell values.
456 * ------------------------------------------------------------------------*/
458 #define TAG_SPEC_MIN 400
459 #define TAG_SPEC_MAX 431
461 #define isSpec(c) (TAG_SPEC_MIN<=(c) && (c)<=TAG_SPEC_MAX)
463 #define NONE 400 /* Dummy stub */
464 #define STAR 401 /* Representing the kind of types */
466 #define ROW 402 /* Representing the kind of rows */
468 #define WILDCARD 403 /* Wildcard pattern */
469 #define SKOLEM 404 /* Skolem constant */
471 #define DOTDOT 405 /* ".." in import/export list */
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 */
483 #define EXT 415 /* whatIs code for isExt */
486 #define SIGDECL 416 /* Signature declaration */
487 #define FIXDECL 417 /* Fixity declaration */
488 #define FUNBIND 418 /* Function binding */
489 #define PATBIND 419 /* Pattern binding */
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 */
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 */
502 #define FM_SOURCE 429 /* denotes source module (FileMode) */
503 #define FM_OBJECT 430 /* denotes object module */
504 #define FM_EITHER 431 /* no restriction; either is allowed */
507 /* --------------------------------------------------------------------------
508 * Tuple data/type constructors:
509 * ------------------------------------------------------------------------*/
511 extern Text ghcTupleText ( Tycon );
512 extern Text ghcTupleText_n ( Int );
517 #error TREX not supported
519 #define isExt(c) (EXTMIN<=(c) && (c)<OFFMIN)
520 #define extText(e) tabExt[(e)-EXTMIN]
521 #define extField(c) arg(fun(c))
522 #define extRow(c) arg(c)
524 extern Text DECTABLE(tabExt);
525 extern Ext mkExt ( Text );
530 extern Module findFakeModule ( Text t );
531 extern Tycon addTupleTycon ( Int n );
532 extern Name addWiredInBoxingTycon
533 ( String modNm, String typeNm, String constrNm,
534 Int rep, Kind kind );
535 extern Tycon addWiredInEnumTycon
536 ( String modNm, String typeNm,
537 List /*of Text*/ constrs );
539 /* --------------------------------------------------------------------------
540 * Offsets: (generic types/stack offsets)
541 * ------------------------------------------------------------------------*/
546 #define isOffset(c) (OFF_MIN<=(c) && (c)<=OFF_MAX)
547 #define offsetOf(c) ((c)-OFF_MIN)
548 #define mkOffset(o) (OFF_MIN+(o))
551 /* --------------------------------------------------------------------------
553 * ------------------------------------------------------------------------*/
555 #define MODULE_BASE_ADDR 5000000
556 #define MODULE_MAX_SIZE 900000
557 #define MODULE_INIT_SIZE 4
560 extern struct strModule* generate_module_ref ( Cell );
561 #define module(mod) (*generate_module_ref(mod))
563 #define module(mod) tabModule[(mod)-MODULE_BASE_ADDR]
566 #define mkModule(n) (MODULE_BASE_ADDR+(n))
567 #define isModule(c) (MODULE_BASE_ADDR<=(c) \
568 && (c)<MODULE_BASE_ADDR+tabModuleSz \
569 && tabModule[(c)-MODULE_BASE_ADDR].inUse)
572 /* Import defns for the ObjectCode struct in Module. */
575 /* Import a machine-dependent definition of Time, for module timestamps. */
576 #include "machdep_time.h"
578 /* Under Haskell 1.3, the list of qualified imports is always a subset
579 * of the list of unqualified imports. For simplicity and flexibility,
580 * we do not attempt to exploit this fact - when a module is imported
581 * unqualified, it is added to both the qualified and unqualified
583 * Similarily, Haskell 1.3 does not allow a constructor to be imported
584 * or exported without exporting the type it belongs to but the export
585 * list is just a flat list of Texts (before static analysis) or
586 * Tycons, Names and Classes (after static analysis).
592 Text text; /* Name of this module */
594 List tycons; /* Lists of top level objects ... */
595 List names; /* (local defns + imports) */
597 List exports; /* [ Entity | (Entity, NIL|DOTDOT) ] */
599 List qualImports; /* Qualified imports. */
601 List codeList; /* [ Name | StgTree ] before code generation,
602 [ Name | CPtr ] afterwards */
604 Bool fake; /* TRUE if module exists only via GHC primop */
605 /* defn; usually FALSE */
607 Cell tree; /* Parse tree for mod or iface */
608 Bool completed; /* Fully loaded or just parsed? */
609 Time lastStamp; /* Time of last parse */
611 Cell mode; /* FM_SOURCE or FM_OBJECT */
612 Text srcExt; /* if mode==FM_SOURCE ".lhs", ".hs", etc */
613 List uses; /* :: [CONID] -- names of mods imported by this one */
615 Text objName; /* Name of the primary object code file. */
616 Int objSize; /* Size of the primary object code file. */
618 ObjectCode* object; /* Primary object code for this module. */
619 ObjectCode* objectExtras; /* And any extras it might need. */
620 List objectExtraNames; /* :: [Text] -- names of extras */
623 extern struct strModule* tabModule;
624 extern Int tabModuleSz;
626 extern Module currentModule; /* Module currently being processed */
627 extern List moduleGraph; /* :: [GRP_REC | GRP_NONREC] */
628 extern List prelModules; /* :: [CONID] */
629 extern List targetModules; /* :: [CONID] */
630 extern Bool nukeModule_needs_major_gc; /* see comment in compiler.c */
632 extern Bool isValidModule ( Module );
633 extern Module newModule ( Text );
634 extern Void nukeModule ( Module );
635 extern Module findModule ( Text );
636 extern Module findModid ( Cell );
637 extern Void setCurrModule ( Module );
638 extern void addToCodeList ( Module, Cell );
639 extern void setNameOrTupleClosure ( Cell c, Cell closure );
640 extern Cell getNameOrTupleClosure ( Cell c );
641 extern void setNameOrTupleClosureCPtr ( Cell c,
642 void* /* StgClosure* */ cptr );
645 extern void addOTabName ( Module,char*,void* );
646 extern void* lookupOTabName ( Module,char* );
647 extern char* nameFromOPtr ( void* );
649 extern void addSection ( Module,void*,void*,OSectionKind );
650 extern OSectionKind lookupSection ( void* );
651 extern void* lookupOExtraTabName ( char* sym );
652 extern void* lookupOTabNameAbsolutelyEverywhere ( char* sym );
654 #define isPrelude(m) (m==modulePrelude)
656 #define N_PRELUDE_SCRIPTS (combined ? 32 : 1)
658 /* --------------------------------------------------------------------------
659 * Type constructor names:
660 * ------------------------------------------------------------------------*/
662 #define TYCON_BASE_ADDR 2000000
663 #define TYCON_MAX_SIZE 900000
664 #define TYCON_INIT_SIZE 4
667 extern struct strTycon* generate_tycon_ref ( Cell );
668 #define tycon(tc) (*generate_tycon_ref(tc))
670 #define tycon(tc) tabTycon[(tc)-TYCON_BASE_ADDR]
673 #define isTycon(c) (TYCON_BASE_ADDR<=(c) \
674 && (c)<TYCON_BASE_ADDR+tabTyconSz \
675 && tabTycon[(c)-TYCON_BASE_ADDR].inUse \
676 && tabTycon[(c)-TYCON_BASE_ADDR].tuple==-1)
677 #define isTuple(c) (TYCON_BASE_ADDR<=(c) \
678 && (c)<TYCON_BASE_ADDR+tabTyconSz \
679 && tabTycon[(c)-TYCON_BASE_ADDR].inUse \
680 && tabTycon[(c)-TYCON_BASE_ADDR].tuple>=0)
681 #define tupleOf(n) (tycon(n).tuple)
683 extern Tycon mkTuple ( Int );
691 Module mod; /* module that defines it */
692 Int tuple; /* tuple number, or -1 if not tuple */
694 Kind kind; /* kind (includes arity) of Tycon */
695 Cell what; /* DATATYPE/SYNONYM/RESTRICTSYN... */
697 Name conToTag; /* used in derived code */
699 void* itbl; /* For tuples, the info tbl pointer */
700 Cell closure; /* Either StgTree, or (later) CPtr, which is the
701 address in the evaluator's heap. Only Tuples
702 use the closure field; all other tycons which
703 require actual code have associated name table
708 extern struct strTycon* tabTycon;
709 extern Int tabTyconSz;
711 extern Tycon newTycon ( Text );
712 extern Tycon findTycon ( Text );
713 extern Tycon addTycon ( Tycon );
714 extern Tycon findQualTycon ( Cell );
715 extern Tycon addPrimTycon ( Text,Kind,Int,Cell,Cell );
717 #define isSynonym(h) (isTycon(h) && tycon(h).what==SYNONYM)
718 #define isQualType(t) (isPair(t) && fst(t)==QUAL)
719 #define mkPolyType(n,t) pair(POLYTYPE,pair(n,t))
720 #define isPolyType(t) (isPair(t) && fst(t)==POLYTYPE)
721 #define isPolyOrQualType(t) (isPair(t) && (fst(t)==POLYTYPE || fst(t)==QUAL))
722 #define polySigOf(t) fst(snd(t))
723 #define monotypeOf(t) snd(snd(t))
724 #define bang(t) ap(BANG,t)
726 extern Tycon findQualTyconWithoutConsultingExportList ( QualId q );
728 extern Int numQualifiers ( Type );
731 /* --------------------------------------------------------------------------
732 * Globally defined name values:
733 * ------------------------------------------------------------------------*/
735 #define NAME_BASE_ADDR 1000000
736 #define NAME_MAX_SIZE 900000
737 #define NAME_INIT_SIZE 4
740 extern struct strName* generate_name_ref ( Cell );
741 #define name(nm) (*generate_name_ref(nm))
743 #define name(nm) tabName[(nm)-NAME_BASE_ADDR]
746 #define mkName(n) (NAME_BASE_ADDR+(n))
747 #define isName(c) (NAME_BASE_ADDR<=(c) \
748 && (c)<NAME_BASE_ADDR+tabNameSz \
749 && tabName[(c)-NAME_BASE_ADDR].inUse)
756 Module mod; /* module that defines it */
763 Bool hasStrict; /* does constructor have strict components? */
764 Text callconv; /* for foreign import/export */
765 void* primop; /* really StgPrim* */
766 void* itbl; /* For constructors, the info tbl pointer */
767 Cell closure; /* Either StgTree, or (later) Ptr, an AsmBCO/
768 AsmCAF/AsmCon thing, or CPtr, which is the
769 address in the evaluator's heap */
773 extern struct strName* tabName;
774 extern Int tabNameSz;
776 extern int numNames ( Void );
778 /* The number field in a name is used to distinguish various kinds of name:
779 * mfunNo(i) = code for member function, offset i
780 * members that are sole elements of dict use mfunNo(0)
781 * members of dicts with more than one elem use mfunNo(n), n>=1
782 * EXECNAME = code for executable name (bytecodes or primitive)
783 * SELNAME = code for selector function
784 * DFUNNAME = code for dictionary builder or selector
785 * cfunNo(i) = code for data constructor
786 * datatypes with only one constructor uses cfunNo(0)
787 * datatypes with multiple constructors use cfunNo(n), n>=1
795 #define isSfun(n) (name(n).number==SELNAME)
796 #define isDfun(n) (name(n).number==DFUNNAME)
798 #define isCfun(n) (name(n).number>=CFUNNAME)
799 #define cfunOf(n) (name(n).number-CFUNNAME)
800 #define cfunNo(i) ((i)+CFUNNAME)
801 #define hasCfun(cs) (nonNull(cs) && isCfun(hd(cs)))
803 #define isMfun(n) (name(n).number<0)
804 #define mfunOf(n) ((-1)-name(n).number)
805 #define mfunNo(i) ((-1)-(i))
807 extern Name newName ( Text,Cell );
808 extern Name findName ( Text );
809 extern Name addName ( Name );
810 extern Name findQualName ( Cell );
811 extern Name addPrimCfun ( Text,Int,Int,Cell );
812 extern Name addPrimCfunREP ( Text,Int,Int,Int );
813 extern Int sfunPos ( Name,Name );
814 extern Name jrsFindQualName ( Text,Text );
816 extern Name findQualNameWithoutConsultingExportList ( QualId q );
818 /* --------------------------------------------------------------------------
820 * ------------------------------------------------------------------------*/
822 #define INST_BASE_ADDR 4000000
823 #define INST_MAX_SIZE 900000
824 #define INST_INIT_SIZE 4
827 extern struct strInst* generate_inst_ref ( Cell );
828 #define inst(in) (*generate_inst_ref(in))
830 #define inst(in) tabInst[(in)-INST_BASE_ADDR]
833 #define mkInst(n) (INST_BASE_ADDR+(n))
834 #define instOf(c) ((Int)((c)-INST_BASE_ADDR))
835 #define isInst(c) (INST_BASE_ADDR<=(c) \
836 && (c)<INST_BASE_ADDR+tabInstSz \
837 && tabInst[(c)-INST_BASE_ADDR].inUse)
842 Class c; /* class C */
844 Module mod; /* module that defines it */
845 Kinds kinds; /* Kinds of variables in head */
846 Cell head; /* :: Pred */
847 List specifics; /* :: [Pred] */
848 Int numSpecifics; /* length(specifics) */
850 Name builder; /* Dictionary constructor function */
853 extern struct strInst* tabInst;
854 extern Int tabInstSz;
856 /* a predicate (an element :: Pred) is an application of a Class to one or
857 * more type expressions
860 #define CCLASS_BASE_ADDR 3000000
861 #define CCLASS_MAX_SIZE 900000
862 #define CCLASS_INIT_SIZE 4
865 extern struct strClass* generate_cclass_ref ( Cell );
866 #define cclass(cl) (*generate_cclass_ref(cl))
868 #define cclass(cl) tabClass[(cl)-CCLASS_BASE_ADDR]
871 #define mkClass(n) (CCLASS_BASE_ADDR+(n))
872 #define isClass(c) (CCLASS_BASE_ADDR<=(c) \
873 && (c)<CCLASS_BASE_ADDR+tabClassSz \
874 && tabClass[(c)-CCLASS_BASE_ADDR].inUse)
879 Text text; /* Name of class */
880 Int line; /* Line where declaration begins */
881 Module mod; /* module that declares it */
882 Int level; /* Level in class hierarchy */
883 Int arity; /* Number of arguments */
884 Kinds kinds; /* Kinds of constructors in class */
885 List fds; /* Functional Dependencies */
886 List xfds; /* Xpanded Functional Dependencies */
887 Cell head; /* Head of class */
888 Name dcon; /* Dictionary constructor function */
889 List supers; /* :: [Pred] */
890 Int numSupers; /* length(supers) */
891 List dsels; /* Superclass dictionary selectors */
892 List members; /* :: [Name] */
893 Int numMembers; /* length(members) */
894 List defaults; /* :: [Name] */
895 List instances; /* :: [Inst] */
898 extern struct strClass* tabClass;
899 extern Int tabClassSz;
901 extern Class newClass ( Text );
902 extern Class findClass ( Text );
903 extern Class addClass ( Class );
904 extern Class findQualClass ( Cell );
905 extern Inst newInst ( Void );
906 extern Inst findFirstInst ( Tycon );
907 extern Inst findNextInst ( Tycon,Inst );
908 extern List getAllKnownTyconsAndClasses ( void );
909 extern Class findQualClassWithoutConsultingExportList ( QualId q );
911 /* --------------------------------------------------------------------------
913 * ------------------------------------------------------------------------*/
915 /* I think this assumes that NUM_CHARS==256. */
916 #define CHARR_MIN 3000
917 #define CHARR_MAX 3255
918 #define isChar(c) (CHARR_MIN<=(c) && (c)<=CHARR_MAX)
919 #define charOf(c) ((Char)((c)-CHARR_MIN))
920 #define mkChar(c) (CHARR_MIN+(((Cell)(c)) & 0xFF))
921 #define MAXCHARVAL (NUM_CHARS-1)
923 /* --------------------------------------------------------------------------
924 * Small Integer values:
925 * ------------------------------------------------------------------------*/
927 #define SMALL_INT_MIN 100000
928 #define SMALL_INT_MAX 499999
929 #define SMALL_INT_ZERO (1 + SMALL_INT_MIN/2 + SMALL_INT_MAX/2)
930 #define isSmall(c) (SMALL_INT_MIN<=(c) && (c)<=SMALL_INT_MAX)
931 extern Bool isInt ( Cell );
932 extern Int intOf ( Cell );
933 extern Cell mkInt ( Int );
935 /* --------------------------------------------------------------------------
936 * Implementation of triples:
937 * ------------------------------------------------------------------------*/
939 #define triple(x,y,z) pair(x,pair(y,z))
940 #define fst3(c) fst(c)
941 #define snd3(c) fst(snd(c))
942 #define thd3(c) snd(snd(c))
944 /* --------------------------------------------------------------------------
945 * Implementation of lists:
946 * ------------------------------------------------------------------------*/
949 #define isNull(c) ((c)==NIL)
950 #define nonNull(c) (c)
951 #define cons(x,xs) pair(x,xs)
952 #define singleton(x) cons(x,NIL)
953 #define doubleton(x,y) cons(x,cons(y,NIL))
954 #define tripleton(x,y,z) cons(x,cons(y,cons(z,NIL)))
958 extern Int length ( List );
959 extern List appendOnto ( List,List ); /* destructive */
960 extern List dupOnto ( List,List );
961 extern List dupList ( List );
962 extern List revOnto ( List, List ); /* destructive */
963 #define rev(xs) revOnto((xs),NIL) /* destructive */
964 #define reverse(xs) revOnto(dupList(xs),NIL) /* non-destructive */
965 extern Cell cellIsMember ( Cell,List );
966 extern Cell cellAssoc ( Cell,List );
967 extern Cell cellRevAssoc ( Cell,List );
968 extern Bool eqList ( List,List );
969 extern Cell varIsMember ( Text,List );
970 extern Name nameIsMember ( Text,List );
971 extern QualId qualidIsMember ( QualId, List );
972 extern Cell intIsMember ( Int,List );
973 extern List replicate ( Int,Cell );
974 extern List diffList ( List,List ); /* destructive */
975 extern List deleteCell ( List,Cell ); /* non-destructive */
976 extern List take ( Int,List ); /* destructive */
977 extern List splitAt ( Int,List ); /* non-destructive */
978 extern Cell nth ( Int,List );
979 extern List removeCell ( Cell,List ); /* destructive */
980 extern List dupListOnto ( List,List ); /* non-destructive */
981 extern List nubList ( List ); /* non-destructive */
983 /* The following macros provide `inline expansion' of some common ways of
984 * traversing, using and modifying lists:
986 * N.B. We use the names _f, _a, _xs, Zs, in an attempt to avoid clashes
987 * with identifiers used elsewhere.
990 #define mapBasic(_init,_step) {List Zs=(_init);\
991 for(;nonNull(Zs);Zs=tl(Zs)) \
993 #define mapModify(_init,_step) mapBasic(_init,hd(Zs)=_step)
995 #define mapProc(_f,_xs) mapBasic(_xs,_f(hd(Zs)))
996 #define map1Proc(_f,_a,_xs) mapBasic(_xs,_f(_a,hd(Zs)))
997 #define map2Proc(_f,_a,_b,_xs) mapBasic(_xs,_f(_a,_b,hd(Zs)))
998 #define map3Proc(_f,_a,_b,_c,_xs) mapBasic(_xs,_f(_a,_b,_c,hd(Zs)))
999 #define map4Proc(_f,_a,_b,_c,_d,_xs) mapBasic(_xs,_f(_a,_b,_c,_d,hd(Zs)))
1001 #define mapOver(_f,_xs) mapModify(_xs,_f(hd(Zs)))
1002 #define map1Over(_f,_a,_xs) mapModify(_xs,_f(_a,hd(Zs)))
1003 #define map2Over(_f,_a,_b,_xs) mapModify(_xs,_f(_a,_b,hd(Zs)))
1004 #define map3Over(_f,_a,_b,_c,_xs) mapModify(_xs,_f(_a,_b,_c,hd(Zs)))
1005 #define map4Over(_f,_a,_b,_c,_d,_xs) mapModify(_xs,_f(_a,_b,_c,_d,hd(Zs)))
1007 /* This is just what you want for functions with accumulating parameters */
1008 #define mapAccum(_f,_acc,_xs) mapBasic(_xs,_acc=_f(_acc,hd(Zs)))
1009 #define map1Accum(_f,_acc,_a,_xs) mapBasic(_xs,_acc=_f(_acc,_a,hd(Zs)))
1010 #define map2Accum(_f,_acc,_a,_b,_xs) mapBasic(_xs,_acc=_f(_acc,_a,_b,hd(Zs)))
1011 #define map3Accum(_f,_acc,_a,_b,_c,_xs) mapBasic(_xs,_acc=_f(_acc,_a,_b,_c,hd(Zs)))
1014 /* --------------------------------------------------------------------------
1015 * Strongly-typed lists (z-lists) and tuples (experimental)
1016 * ------------------------------------------------------------------------*/
1019 typedef Cell ZTriple;
1023 #define isZPair(c) (whatIs((c))==ZTUP2)
1025 extern Cell zpair ( Cell x1, Cell x2 );
1026 extern Cell zfst ( Cell zpair );
1027 extern Cell zsnd ( Cell zpair );
1029 extern Cell ztriple ( Cell x1, Cell x2, Cell x3 );
1030 extern Cell zfst3 ( Cell zpair );
1031 extern Cell zsnd3 ( Cell zpair );
1032 extern Cell zthd3 ( Cell zpair );
1034 extern Cell z4ble ( Cell x1, Cell x2, Cell x3, Cell x4 );
1035 extern Cell zsel14 ( Cell zpair );
1036 extern Cell zsel24 ( Cell zpair );
1037 extern Cell zsel34 ( Cell zpair );
1038 extern Cell zsel44 ( Cell zpair );
1040 extern Cell z5ble ( Cell x1, Cell x2, Cell x3, Cell x4, Cell x5 );
1041 extern Cell zsel15 ( Cell zpair );
1042 extern Cell zsel25 ( Cell zpair );
1043 extern Cell zsel35 ( Cell zpair );
1044 extern Cell zsel45 ( Cell zpair );
1045 extern Cell zsel55 ( Cell zpair );
1047 extern Cell unap ( int tag, Cell c );
1050 /* --------------------------------------------------------------------------
1051 * Implementation of function application nodes:
1052 * ------------------------------------------------------------------------*/
1054 #define ap(f,x) pair(f,x)
1055 #define ap1(f,x) ap(f,x)
1056 #define ap2(f,x,y) ap(ap(f,x),y)
1057 #define ap3(f,x,y,z) ap(ap(ap(f,x),y),z)
1058 #define fun(c) fst(c)
1059 #define arg(c) snd(c)
1060 #define isAp(c) (isPair(c) && !isTag(fst(c)))
1062 extern Cell getHead ( Cell );
1063 extern List getArgs ( Cell );
1064 extern Cell nthArg ( Int,Cell );
1065 extern Int numArgs ( Cell );
1066 extern Cell applyToArgs ( Cell,List );
1067 extern Int argCount;
1069 /* --------------------------------------------------------------------------
1070 * Stack implementation:
1072 * NB: Use of macros makes order of evaluation hard to predict.
1073 * For example, "push(1+pop());" doesn't increment TOS.
1074 * ------------------------------------------------------------------------*/
1076 extern Cell cellStack[];
1079 #define clearStack() sp=(-1)
1080 #define stackEmpty() (sp==(-1))
1081 #define stack(p) cellStack[p]
1082 #define chkStack(n) if (sp>=NUM_STACK-(n)) hugsStackOverflow()
1083 #define push(c) do { chkStack(1); onto(c); } while (0)
1084 #define onto(c) stack(++sp)=(c);
1085 #define pop() stack(sp--)
1087 #define top() stack(sp)
1088 #define pushed(n) stack(sp-(n))
1089 #define topfun(f) top()=ap((f),top())
1090 #define toparg(x) top()=ap(top(),(x))
1093 extern Void hugsStackOverflow ( Void );
1097 #define STACK_HEADROOM 16384
1098 #define STACK_CHECK if (StackSpace() <= STACK_HEADROOM) \
1099 internal("Macintosh function parameter stack overflow.");
1104 /* --------------------------------------------------------------------------
1106 * ------------------------------------------------------------------------*/
1108 extern Void setLastExpr ( Cell );
1109 extern Cell getLastExpr ( Void );
1110 extern List addTyconsMatching ( String,List );
1111 extern List addNamesMatching ( String,List );
1113 extern Tycon findTyconInAnyModule ( Text t );
1114 extern Class findClassInAnyModule ( Text t );
1115 extern Name findNameInAnyModule ( Text t );
1117 extern Void print ( Cell, Int );
1118 extern void dumpTycon ( Int t );
1119 extern void dumpName ( Int n );
1120 extern void dumpClass ( Int c );
1121 extern void dumpInst ( Int i );
1122 extern void locateSymbolByName ( Text t );
1124 /*-------------------------------------------------------------------------*/