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.34 $
  14  * $Date: 2000/03/13 11:37:17 $
  15  * ------------------------------------------------------------------------*/
  16
  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  * ------------------------------------------------------------------------*/
  24
  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    */
  46 #if TREX
  47 typedef Cell         Ext;                        /* extension label        */
  48 #endif
  49
  50 typedef Cell         ConId;
  51 typedef Cell         VarId;
  52 typedef Cell         QualId;
  53 typedef Cell         ConVarId;
  54
  55 /* --------------------------------------------------------------------------
  56  * Text storage:
  57  * provides storage for the characters making up identifier and symbol
  58  * names, string literals, character constants etc...
  59  * ------------------------------------------------------------------------*/
  60
  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 );
  68
  69 /* Variants of textToStr and syntaxOf which work for idents, ops whether
  70  * qualified or unqualified.
  71  */
  72 extern  String       identToStr         ( Cell );
  73 extern  Text         fixLitText         ( Text );
  74 extern  Syntax       identSyntax        ( Cell );
  75 extern  Syntax       defaultSyntax      ( Text );
  76
  77 /* --------------------------------------------------------------------------
  78  * Specification of syntax (i.e. default written form of application)
  79  * ------------------------------------------------------------------------*/
  80
  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
  90
  91 #define UMINUS_PREC  6                  /* Change these settings at your   */
  92 #define UMINUS_ASSOC LEFT_ASS           /* own risk; they may not work!    */
  93
  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)
  99
 100 extern  Void   addSyntax  ( Int,Text,Syntax );
 101 extern  Syntax syntaxOf   ( Text );
 102
 103 /* --------------------------------------------------------------------------
 104  * Heap storage:
 105  * Provides a garbage collectable heap for storage of expressions etc.
 106  * ------------------------------------------------------------------------*/
 107
 108 #define heapAlloc(s) (Heap)(farCalloc(s,sizeof(Cell)))
 109 #define heapBuilt()  (heapFst)
 110 extern  Int          heapSize;
 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      */
 117
 118 #define fst(c)       heapTopFst[c]
 119 #define snd(c)       heapTopSnd[c]
 120
 121 extern  Pair         pair            ( Cell,Cell );
 122 extern  Void         garbageCollect  ( Void );
 123
 124 extern  Void         overwrite       ( Pair,Pair );
 125 extern  Void         overwrite2      ( Pair,Cell,Cell );
 126 extern  Cell         markExpr        ( Cell );
 127 extern  Void         markWithoutMove ( Cell );
 128
 129 #define mark(v)      v=markExpr(v)
 130
 131 #define isPair(c)    ((c)<0)
 132 #define isGenPair(c) ((c)<0 && -heapSize<=(c))
 133
 134 extern  Cell         whatIs    ( Cell );
 135
 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  * ------------------------------------------------------------------------*/
 142
 143 #if !defined(SIZEOF_VOID_P) || !defined(SIZEOF_INT)
 144 #error SIZEOF_VOID_P or SIZEOF_INT is not defined
 145 #endif
 146
 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*/
 152
 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   */
 166
 167 #if IPARAM
 168 #define IPCELL       19           /* Imp Param Cell:          snd :: Text  */
 169 #define IPVAR        20           /* ?x:                      snd :: Text  */
 170 #endif
 171
 172 #if TREX
 173 #define EXTCOPY      22           /* Copy of an Ext:          snd :: Text  */
 174 #endif
 175
 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)
 192 #if IPARAM
 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))
 197 #else
 198 #define isIP(p)         FALSE
 199 #endif
 200
 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 );
 210
 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)))
 217
 218 #define stringToBignum(s) pair(BIGCELL,findText(s))
 219 #define bignumToString(b) textToStr(snd(b))
 220
 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 );
 227
 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
 231  * pair.
 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  * ------------------------------------------------------------------------*/
 236
 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                */
 261
 262 #if IPARAM
 263 #define WITHEXP      58           /* WITHEXP    snd :: [(Var,Exp)]         */
 264 #endif
 265
 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)       */
 273
 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]) */
 277 #if TREX
 278 #define RECORD       70           /* RECORD     snd :: [Val]               */
 279 #define EXTCASE      71           /* EXTCASE    snd :: (Exp,Disc,Rhs)      */
 280 #define RECSEL       72           /* RECSEL     snd :: Ext                 */
 281 #endif
 282 #define IMPDEPS      73           /* IMPDEPS    snd :: [Binding]           */
 283
 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      */
 287
 288 #define INFIX        77           /* INFIX      snd :: (see tidyInfix)     */
 289 #define ONLY         78           /* ONLY       snd :: Exp                 */
 290 #define NEG          79           /* NEG        snd :: Exp                 */
 291
 292 /* Used when parsing GHC interface files */
 293 #define DICTAP       80           /* DICTAP     snd :: (QClassId,[Type])   */
 294 #define UNBOXEDTUP   81           /* UNBOXEDTUP snd :: [Type]              */
 295
 296 #if SIZEOF_VOID_P != SIZEOF_INT
 297 #define PTRCELL      82           /* C Heap Pointer snd :: (Int,Int)       */
 298 #endif
 299
 300 /* STG syntax */
 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)        */
 309
 310
 311 /*
 312    Top-level interface entities
 313    type Line             = Int  -- a line number
 314    type ConVarId         = CONIDCELL | VARIDCELL
 315    type <a>              = ZList a
 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
 322    z-tuples.
 323 */
 324
 325 #define I_INTERFACE  109  /* snd :: ((ConId, [I_IMPORT..I_VALUE]))
 326                                     interface name, list of iface entities */
 327
 328 #define I_IMPORT     110  /* snd :: ((ConId, [ConVarId]))
 329                                     module name, list of entities          */
 330
 331 #define I_INSTIMPORT 111  /* snd :: NIL    -- not used at present          */
 332
 333 #define I_EXPORT     112  /* snd :: ((ConId, [ExportListEntry]))
 334                                     this module name?, entities to export  */
 335
 336 #define I_FIXDECL    113  /* snd :: ((NIL|Int, Associativity, ConVarId))
 337                                     fixity, associativity, name            */
 338
 339 #define I_INSTANCE   114 /* snd :: ((Line,
 340                                      [((VarId,Kind))],
 341                                      Type, VarId, Inst))
 342                    lineno,
 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    */
 347
 348 #define I_TYPE       115 /* snd :: ((Line, ConId, [((VarId,Kind))], Type))
 349                             lineno, tycon, kinded tyvars, the type expr    */
 350
 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. */
 355
 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. */
 360
 361 #define I_CLASS      118 /* snd :: ((Line, [((QConId,VarId))], ConId,
 362                                     [((VarId,Kind))], [((VarId,Type))]))
 363                             lineno, context, classname,
 364                                       kinded tyvars, method sigs           */
 365
 366 #define I_VALUE      119 /* snd :: ((Line, VarId, Type))                   */
 367
 368
 369
 370 /* Generic syntax */
 371 #if 0
 372 #define ZCONS        190          /* snd :: (Cell,Cell)                    */
 373 #endif
 374
 375
 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))))  */
 380
 381 /* Last constructor tag must be less than SPECMIN */
 382
 383 /* --------------------------------------------------------------------------
 384  * Special cell values:
 385  * ------------------------------------------------------------------------*/
 386
 387 #define SPECMIN      201
 388
 389 #if TREX
 390 #define isSpec(c)    (SPECMIN<=(c) && (c)<EXTMIN)/* Special cell values    */
 391 #else
 392 #define isSpec(c)    (SPECMIN<=(c) && (c)<OFFMIN)
 393 #endif
 394
 395 #define NONE         201          /* Dummy stub                            */
 396 #define STAR         202          /* Representing the kind of types        */
 397 #if TREX
 398 #define ROW          203          /* Representing the kind of rows         */
 399 #endif
 400 #define WILDCARD     204          /* Wildcard pattern                      */
 401 #define SKOLEM       205          /* Skolem constant                       */
 402
 403 #define DOTDOT       206          /* ".." in import/export list            */
 404
 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                */
 414 #if TREX
 415 #define EXT          219          /* whatIs code for isExt                 */
 416 #endif
 417
 418 #define SIGDECL      220          /* Signature declaration                 */
 419 #define FIXDECL      221          /* Fixity declaration                    */
 420 #define FUNBIND      222          /* Function binding                      */
 421 #define PATBIND      223          /* Pattern binding                       */
 422
 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         */
 427
 428 #define NODEPENDS    235          /* Stop calculation of deps in type check*/
 429 #define PREDEFINED   236          /* Predefined name, not yet filled       */
 430
 431 /* --------------------------------------------------------------------------
 432  * Tuple data/type constructors:
 433  * ------------------------------------------------------------------------*/
 434
 435 extern Text ghcTupleText    ( Tycon );
 436 extern Text ghcTupleText_n  ( Int );
 437
 438
 439
 440 #if TREX
 441 #define EXTMIN       301
 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)
 446
 447 extern Text          DECTABLE(tabExt);
 448 extern Ext           mkExt ( Text );
 449 #else
 450 #define mkExt(t) NIL
 451 #endif
 452
 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 );
 460
 461 /* --------------------------------------------------------------------------
 462  * Offsets: (generic types/stack offsets)
 463  * ------------------------------------------------------------------------*/
 464
 465 #if TREX
 466 #define OFFMIN       (EXTMIN+NUM_EXT)
 467 #else
 468 #define OFFMIN       301
 469 #endif
 470 #define isOffset(c)  (OFFMIN<=(c) && (c)<MODMIN)
 471 #define offsetOf(c)  ((c)-OFFMIN)
 472 #define mkOffset(o)  (OFFMIN+(o))
 473
 474
 475 /* --------------------------------------------------------------------------
 476  * Modules:
 477  * ------------------------------------------------------------------------*/
 478
 479 #define MODMIN        (OFFMIN+NUM_OFFSETS)
 480
 481 #define isModule(c)   (MODMIN<=(c) && (c)<TYCMIN)
 482 #define mkModule(n)   (MODMIN+(n))
 483 #define module(n)     tabModule[(n)-MODMIN]
 484
 485 /* Import defns for the ObjectCode struct in Module. */
 486 #include "object.h"
 487
 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
 492  * import lists.
 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).
 497  */
 498 struct Module {
 499     Text  text;
 500     /* Lists of top level objects (local defns + imports)                  */
 501     List  tycons;
 502     List  names;
 503     List  classes;
 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.
 507      */
 508     List  qualImports;
 509
 510     /* TRUE if module exists only via GHC primop defn; usually FALSE */
 511     Bool  fake;
 512
 513     /* The primary object file for this module. */
 514     ObjectCode* object;
 515
 516     /* And any extras it might need. */
 517     ObjectCode* objectExtras;
 518     List        objectExtraNames;   /* :: [Text] -- names of extras */
 519 };
 520
 521
 522 extern Module currentModule;           /* Module currently being processed */
 523 extern struct Module DECTABLE(tabModule);
 524
 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 );
 530
 531 extern void      addOTabName     ( Module,char*,void* );
 532 extern void*     lookupOTabName  ( Module,char* );
 533 extern char*     nameFromOPtr    ( void* );
 534
 535 extern void          addSection    ( Module,void*,void*,OSectionKind );
 536 extern OSectionKind  lookupSection ( void* );
 537 extern void* lookupOExtraTabName ( char* sym );
 538
 539 #define isPrelude(m) (m==modulePrelude)
 540
 541 #define N_PRELUDE_SCRIPTS (combined ? 32 : 1)
 542
 543 /* --------------------------------------------------------------------------
 544  * Type constructor names:
 545  * ------------------------------------------------------------------------*/
 546
 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]
 550
 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 );
 554
 555
 556 struct strTycon {
 557     Text   text;
 558     Int    line;
 559     Module mod;                         /* module that defines it          */
 560     Int    tuple;                      /* tuple number, or -1 if not tuple */
 561     Int    arity;
 562     Kind   kind;                        /* kind (includes arity) of Tycon  */
 563     Cell   what;                        /* DATATYPE/SYNONYM/RESTRICTSYN... */
 564     Cell   defn;
 565     Name   conToTag;                    /* used in derived code            */
 566     Name   tagToCon;
 567     void*  itbl;                       /* For tuples, the info tbl pointer */
 568     Tycon  nextTyconHash;
 569 };
 570
 571 extern struct strTycon DECTABLE(tabTycon);
 572
 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 );
 578
 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))
 586
 587 #define bang(t)         ap(BANG,t)
 588 extern Tycon findQualTyconWithoutConsultingExportList ( QualId q );
 589
 590 /* --------------------------------------------------------------------------
 591  * Globally defined name values:
 592  * ------------------------------------------------------------------------*/
 593
 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]
 598
 599 struct strName {
 600     Text   text;
 601     Int    line;
 602     Module mod;                         /* module that defines it          */
 603     Syntax syntax;
 604     Cell   parent;
 605     Int    arity;
 606     Int    number;
 607     Cell   type;
 608     Cell   defn;
 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 */
 613     Name   nextNameHash;
 614 };
 615
 616 extern int numNames (  Void  );
 617
 618 extern struct strName DECTABLE(tabName);
 619
 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
 630  */
 631
 632 #define EXECNAME        0
 633 #define SELNAME         1
 634 #define DFUNNAME        2
 635 #define CFUNNAME        3
 636
 637 #define isSfun(n)       (name(n).number==SELNAME)
 638 #define isDfun(n)       (name(n).number==DFUNNAME)
 639
 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)))
 644
 645 #define isMfun(n)       (name(n).number<0)
 646 #define mfunOf(n)       ((-1)-name(n).number)
 647 #define mfunNo(i)       ((-1)-(i))
 648
 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 );
 658
 659 extern Name findQualNameWithoutConsultingExportList ( QualId q );
 660
 661 /* --------------------------------------------------------------------------
 662  * Type class values:
 663  * ------------------------------------------------------------------------*/
 664
 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]
 670
 671 struct strInst {
 672     Class  c;                           /* class C                         */
 673     Int    line;
 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)               */
 679     List   implements;
 680     Name   builder;                     /* Dictionary constructor function */
 681 };
 682
 683 /* a predicate (an element :: Pred) is an application of a Class to one or
 684  * more type expressions
 685  */
 686
 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]
 691
 692 struct strClass {
 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]                       */
 710 };
 711
 712 extern struct strClass    DECTABLE(tabClass);
 713 extern struct strInst far *tabInst;
 714
 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 );
 725
 726 /* --------------------------------------------------------------------------
 727  * Character values:
 728  * ------------------------------------------------------------------------*/
 729
 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)))
 735
 736 /* --------------------------------------------------------------------------
 737  * Small Integer values:
 738  * ------------------------------------------------------------------------*/
 739
 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))
 748
 749 extern  Bool isInt    ( Cell );
 750 extern  Int  intOf    ( Cell );
 751 extern  Cell mkInt    ( Int );
 752
 753 /* --------------------------------------------------------------------------
 754  * Implementation of triples:
 755  * ------------------------------------------------------------------------*/
 756
 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))
 761
 762 /* --------------------------------------------------------------------------
 763  * Implementation of lists:
 764  * ------------------------------------------------------------------------*/
 765
 766 #define NIL          0
 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)))
 773 #define hd(c)        fst(c)
 774 #define tl(c)        snd(c)
 775
 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 */
 800
 801 /* The following macros provide `inline expansion' of some common ways of
 802  * traversing, using and modifying lists:
 803  *
 804  * N.B. We use the names _f, _a, _xs, Zs, in an attempt to avoid clashes
 805  *      with identifiers used elsewhere.
 806  */
 807
 808 #define mapBasic(_init,_step)           {List Zs=(_init);\
 809                                          for(;nonNull(Zs);Zs=tl(Zs))  \
 810                                          _step;}
 811 #define mapModify(_init,_step)          mapBasic(_init,hd(Zs)=_step)
 812
 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)))
 818
 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)))
 824
 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)))
 830
 831
 832 /* --------------------------------------------------------------------------
 833  * Strongly-typed lists (z-lists) and tuples (experimental)
 834  * ------------------------------------------------------------------------*/
 835
 836 typedef Cell ZPair;
 837 typedef Cell ZTriple;
 838 typedef Cell Z4Ble;
 839 typedef Cell Z5Ble;
 840
 841 #if 0
 842 typedef Cell ZList;
 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 );
 850 #endif
 851
 852 extern Cell zpair ( Cell x1, Cell x2 );
 853 extern Cell zfst ( Cell zpair );
 854 extern Cell zsnd ( Cell zpair );
 855
 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 );
 860
 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 );
 866
 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 );
 873
 874 extern Cell unap ( int tag, Cell c );
 875 #define isZPair(c) (whatIs((c))==ZTUP2)
 876
 877 /* --------------------------------------------------------------------------
 878  * Implementation of function application nodes:
 879  * ------------------------------------------------------------------------*/
 880
 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 );
 890 extern  Int          argCount;
 891 extern  Cell         nthArg      ( Int,Cell );
 892 extern  Int          numArgs     ( Cell );
 893 extern  Cell         applyToArgs ( Cell,List );
 894
 895 /* --------------------------------------------------------------------------
 896  * Stack implementation:
 897  *
 898  * NB: Use of macros makes order of evaluation hard to predict.
 899  *     For example, "push(1+pop());" doesn't increment TOS.
 900  * ------------------------------------------------------------------------*/
 901
 902 extern  Cell DECTABLE(cellStack);
 903 extern  StackPtr sp;
 904
 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()
 909 #define push(c)      \
 910   do {               \
 911     chkStack(1);     \
 912     onto(c);         \
 913   } while (0)
 914 #define onto(c)      stack(++sp)=(c);
 915 #define pop()        stack(sp--)
 916 #define drop()       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))
 921
 922 extern  Void hugsStackOverflow ( Void );
 923
 924 #if SYMANTEC_C
 925 #include <Memory.h>
 926 #define STACK_HEADROOM 16384
 927 #define STACK_CHECK if (StackSpace() <= STACK_HEADROOM) \
 928                       internal("Macintosh function parameter stack overflow.");
 929 #else
 930 #define STACK_CHECK
 931 #endif
 932
 933 /* --------------------------------------------------------------------------
 934  * Script file control:
 935  * The implementation of script file storage is hidden.
 936  * ------------------------------------------------------------------------*/
 937
 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 );
 950
 951
 952 /* --------------------------------------------------------------------------
 953  * Misc:
 954  * ------------------------------------------------------------------------*/
 955
 956 extern  Void   setLastExpr       ( Cell );
 957 extern  Cell   getLastExpr       ( Void );
 958 extern  List   addTyconsMatching ( String,List );
 959 extern  List   addNamesMatching  ( String,List );
 960
 961 extern  Tycon findTyconInAnyModule ( Text t );
 962 extern  Class findClassInAnyModule ( Text t );
 963 extern  Name  findNameInAnyModule  ( Text t );
 964
 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 );
 971
 972 /*-------------------------------------------------------------------------*/