ghc/interpreter/storage.h

   1 /* -*- mode: hugs-c; -*- */
   2 /* --------------------------------------------------------------------------
   3  * Defines storage datatypes: Text, Name, Module, Tycon, Cell, List, Pair,
   4  * Triple, ...
   5  *
   6  * Copyright (c) The University of Nottingham and Yale University, 1994-1997.
   7  * All rights reserved. See NOTICE for details and conditions of use etc...
   8  * Hugs version 1.4, December 1997
   9  *
  10  * $RCSfile: storage.h,v $
  11  * $Revision: 1.2 $
  12  * $Date: 1998/12/02 13:22:43 $
  13  * ------------------------------------------------------------------------*/
  14
  15 /* --------------------------------------------------------------------------
  16  * Typedefs for main data types:
  17  * Many of these type names are used to indicate the intended us of a data
  18  * item, rather than for type checking purposes.  Sadly (although sometimes,
  19  * fortunately), the C compiler cannot distinguish between the use of two
  20  * different names defined to be synonyms for the same types.
  21  * ------------------------------------------------------------------------*/
  22
  23 typedef Int          Text;                       /* text string            */
  24 typedef Word         Syntax;                     /* syntax (assoc,preced)  */
  25 typedef Int          Cell;                       /* general cell value     */
  26 typedef Cell far     *Heap;                      /* storage of heap        */
  27 typedef Cell         Pair;                       /* pair cell              */
  28 typedef Int          StackPtr;                   /* stack pointer          */
  29 typedef Cell         Offset;                     /* offset/generic variable*/
  30 typedef Int          Script;                     /* script file number     */
  31 typedef Int          Module;                     /* module                 */
  32 typedef Cell         Tycon;                      /* type constructor       */
  33 typedef Cell         Type;                       /* type expression        */
  34 typedef Cell         Kind;                       /* kind expression        */
  35 typedef Cell         Kinds;                      /* list of kinds          */
  36 typedef Cell         Constr;                     /* constructor expression */
  37 typedef Cell         Name;                       /* named value            */
  38 typedef Cell         Class;                      /* type class             */
  39 typedef Cell         Inst;                       /* instance of type class */
  40 typedef Cell         Triple;                     /* triple of cell values  */
  41 typedef Cell         List;                       /* list of cells          */
  42 typedef Cell         Bignum;                     /* integer literal        */
  43 typedef Cell         Float;                      /* floating pt literal    */
  44 #if TREX
  45 typedef Cell         Ext;                        /* extension label        */
  46 #endif
  47
  48 /* --------------------------------------------------------------------------
  49  * Text storage:
  50  * provides storage for the characters making up identifier and symbol
  51  * names, string literals, character constants etc...
  52  * ------------------------------------------------------------------------*/
  53
  54 extern  String       textToStr          Args((Text));
  55 extern  Text         findText           Args((String));
  56 extern  Text         inventText         Args((Void));
  57 extern  Text         inventDictText     Args((Void));
  58 extern  Bool         inventedText       Args((Text));
  59
  60 /* Variants of textToStr and syntaxOf which work for idents, ops whether
  61  * qualified or unqualified.
  62  */
  63 extern  String       identToStr         Args((Cell));
  64 extern  Syntax       identSyntax        Args((Cell));
  65 extern  Syntax       defaultSyntax      Args((Text));
  66
  67 /* --------------------------------------------------------------------------
  68  * Specification of syntax (i.e. default written form of application)
  69  * ------------------------------------------------------------------------*/
  70
  71 #define MIN_PREC  0                    /* weakest binding operator         */
  72 #define MAX_PREC  9                    /* strongest binding operator       */
  73 #define FUN_PREC  (MAX_PREC+2)         /* binding of function symbols      */
  74 #define DEF_PREC  MAX_PREC
  75 #define APPLIC    00000                /* written applicatively            */
  76 #define LEFT_ASS  02000                /* left associative infix           */
  77 #define RIGHT_ASS 04000                /* right associative infix          */
  78 #define NON_ASS   06000                /* non associative infix            */
  79 #define DEF_ASS   NON_ASS
  80
  81 #define assocOf(x)      ((x)&NON_ASS)
  82 #define precOf(x)       ((x)&(~NON_ASS))
  83 #define mkSyntax(a,p)   ((a)|(p))
  84 #define DEF_OPSYNTAX    mkSyntax(DEF_ASS,DEF_PREC)
  85
  86 extern  Void   addSyntax  Args((Int,Text,Syntax));
  87 extern  Syntax syntaxOf   Args((Text));
  88
  89 /* --------------------------------------------------------------------------
  90  * Heap storage:
  91  * Provides a garbage collectable heap for storage of expressions etc.
  92  * ------------------------------------------------------------------------*/
  93
  94 #define heapAlloc(s) (Heap)(farCalloc(s,sizeof(Cell)))
  95 #define heapBuilt()  (heapFst)
  96 extern  Int          heapSize;
  97 extern  Heap         heapFst, heapSnd;
  98 extern  Heap         heapTopFst;
  99 extern  Heap         heapTopSnd;
 100 extern  Bool         consGC;            /* Set to FALSE to turn off gc from*/
 101                                         /* C stack; use with extreme care! */
 102 extern Int   cellsRecovered;            /* cells recovered by last gc      */
 103
 104 #define fst(c)       heapTopFst[c]
 105 #define snd(c)       heapTopSnd[c]
 106
 107 extern  Pair         pair            Args((Cell,Cell));
 108 extern  Void         garbageCollect  Args((Void));
 109
 110 extern  Void         overwrite       Args((Pair,Pair));
 111 extern  Void         overwrite2      Args((Pair,Cell,Cell));
 112 extern  Cell         markExpr        Args((Cell));
 113 extern  Void         markWithoutMove Args((Cell));
 114
 115 #define mark(v)      v=markExpr(v)
 116
 117 #define isPair(c)    ((c)<0)
 118 #define isGenPair(c) ((c)<0 && -heapSize<=(c))
 119
 120 extern  Cell         whatIs    Args((Cell));
 121
 122 /* --------------------------------------------------------------------------
 123  * Box cell tags are used as the fst element of a pair to indicate that
 124  * the snd element of the pair is to be treated in some special way, other
 125  * than as a Cell.  Examples include holding integer values, variable name
 126  * and string text etc.
 127  * ------------------------------------------------------------------------*/
 128
 129 #define TAGMIN       1            /* Box and constructor cell tag values   */
 130 #define BCSTAG       20           /* Box=TAGMIN..BCSTAG-1                  */
 131 #define isTag(c)     (TAGMIN<=(c) && (c)<SPECMIN) /* Tag cell values       */
 132 #define isBoxTag(c)  (TAGMIN<=(c) && (c)<BCSTAG)  /* Box cell tag values   */
 133 #define isConTag(c)  (BCSTAG<=(c) && (c)<SPECMIN) /* Constr cell tag values*/
 134
 135 #define FREECELL     3            /* Free list cell:          snd :: Cell  */
 136 #define VARIDCELL    4            /* Identifier variable:     snd :: Text  */
 137 #define VAROPCELL    5            /* Operator variable:       snd :: Text  */
 138 #define DICTVAR      6            /* Dictionary variable:     snd :: Text  */
 139 #define CONIDCELL    7            /* Identifier constructor:  snd :: Text  */
 140 #define CONOPCELL    8            /* Operator constructor:    snd :: Text  */
 141 #define STRCELL      9            /* String literal:          snd :: Text  */
 142 #define INTCELL      10           /* Int literal:             snd :: Int   */
 143 #define FLOATCELL    15           /* Floating Pt literal:     snd :: Text  */
 144 #define BIGCELL      16           /* Integer literal:         snd :: Text  */
 145 #if PTR_ON_HEAP
 146 #define PTRCELL      17           /* C Heap Pointer           snd :: Ptr   */
 147 #endif
 148 #if TREX
 149 #define EXTCOPY      18           /* Copy of an Ext:          snd :: Text  */
 150 #endif
 151
 152 #define textOf(c)       ((Text)(snd(c)))         /* c ::  (VAR|CON)(ID|OP) */
 153 #define qmodOf(c)       (textOf(fst(snd(c))))    /* c ::  QUALIDENT        */
 154 #define qtextOf(c)      (textOf(snd(snd(c))))    /* c ::  QUALIDENT        */
 155 #define mkVar(t)        ap(VARIDCELL,t)
 156 #define mkVarop(t)      ap(VAROPCELL,t)
 157 #define mkCon(t)        ap(CONIDCELL,t)
 158 #define mkConop(t)      ap(CONOPCELL,t)
 159 #define mkQVar(m,t)     ap(QUALIDENT,pair(mkCon(m),mkVar(t)))
 160 #define mkQCon(m,t)     ap(QUALIDENT,pair(mkCon(m),mkCon(t)))
 161 #define mkQVarOp(m,t)   ap(QUALIDENT,pair(mkCon(m),mkVarop(t)))
 162 #define mkQConOp(m,t)   ap(QUALIDENT,pair(mkCon(m),mkConop(t)))
 163 #define intValOf(c)     (snd(c))
 164 #define inventVar()     mkVar(inventText())
 165 #define mkDictVar(t)    ap(DICTVAR,t)
 166 #define inventDictVar() mkDictVar(inventDictText())
 167 #define mkStr(t)        ap(STRCELL,t)
 168 extern  Bool            isVar       Args((Cell));
 169 extern  Bool            isCon       Args((Cell));
 170 extern  Bool            isQVar      Args((Cell));
 171 extern  Bool            isQCon      Args((Cell));
 172 extern  Bool            isQualIdent Args((Cell));
 173 extern  Bool            isIdent     Args((Cell));
 174
 175 extern  String           stringNegate Args((String));
 176
 177 #define intEq(x,y)       (intOf(x) == intOf(y))
 178 #define intNegate(x)     mkInt(-intOf(x))
 179
 180 #define isFloat(c)       (isPair(c) && fst(c)==FLOATCELL)
 181 #define stringToFloat(s) pair(FLOATCELL,findText(s))
 182 #define floatToString(f) textToStr(snd(f))
 183 #define floatEq(f1,f2)   (snd(f1) == snd(f2))
 184 #define floatNegate(f)   stringToFloat(stringNegate(floatToString(f)))
 185 #define floatOf(f)       atof(floatToString(f))
 186
 187 #define isBignum(c)       (isPair(c) && fst(c)==BIGCELL)
 188 #define stringToBignum(s) pair(BIGCELL,findText(s))
 189 #define bignumToString(b) textToStr(snd(b))
 190 #define bignumEq(b1,b2)   (snd(b1) == snd(b2))
 191 #define bignumNegate(b)   stringToBignum(stringNegate(bignumToString(b)))
 192 #define bignumOf(b)       atoi(bignumToString(b))   /* ToDo: overflow check */
 193
 194 #if PTR_ON_HEAP
 195 #define isPtr(c)        (isPair(c) && fst(c)==PTRCELL)
 196 extern  Cell            mkPtr           Args((Ptr));
 197 extern  Ptr             ptrOf           Args((Cell));
 198 #endif
 199
 200 /* --------------------------------------------------------------------------
 201  * Constructor cell tags are used as the fst element of a pair to indicate
 202  * a particular syntactic construct described by the snd element of the
 203  * pair.
 204  * Note that a cell c will not be treated as an application (AP/isAp) node
 205  * if its first element is a constructor cell tag, whereas a cell whose fst
 206  * element is a special cell will be treated as an application node.
 207  * ------------------------------------------------------------------------*/
 208
 209 #define LETREC       20           /* LETREC     snd :: ([Decl],Exp)        */
 210 #define COND         21           /* COND       snd :: (Exp,Exp,Exp)       */
 211 #define LAMBDA       22           /* LAMBDA     snd :: Alt                 */
 212 #define FINLIST      23           /* FINLIST    snd :: [Exp]               */
 213 #define DOCOMP       24           /* DOCOMP     snd :: (Exp,[Qual])        */
 214 #define BANG         25           /* BANG       snd :: Type                */
 215 #define COMP         26           /* COMP       snd :: (Exp,[Qual])        */
 216 #define ASPAT        27           /* ASPAT      snd :: (Var,Exp)           */
 217 #define ESIGN        28           /* ESIGN      snd :: (Exp,Type)          */
 218 #define CASE         29           /* CASE       snd :: (Exp,[Alt])         */
 219 #define NUMCASE      30           /* NUMCASE    snd :: (Exp,Disc,Rhs)      */
 220 #define FATBAR       31           /* FATBAR     snd :: (Exp,Exp)           */
 221 #define LAZYPAT      32           /* LAZYPAT    snd :: Exp                 */
 222 #define DERIVE       35           /* DERIVE     snd :: Cell                */
 223 #if NPLUSK
 224 #define ADDPAT       36           /* (_+k) pattern discr: snd :: Cell      */
 225 #endif
 226
 227 #define BOOLQUAL     39           /* BOOLQUAL   snd :: Exp                 */
 228 #define QWHERE       40           /* QWHERE     snd :: [Decl]              */
 229 #define FROMQUAL     41           /* FROMQUAL   snd :: (Exp,Exp)           */
 230 #define DOQUAL       42           /* DOQUAL     snd :: Exp                 */
 231
 232 #define GUARDED      44           /* GUARDED    snd :: [guarded exprs]     */
 233
 234 #define ARRAY        45           /* Array:     snd :: (Bounds,[Values])   */
 235 #define MUTVAR       46           /* Mutvar:    snd :: Cell                */
 236
 237 #define POLYTYPE     50           /* POLYTYPE   snd :: (Kind,Type)         */
 238 #define QUAL         51           /* QUAL       snd :: ([Classes],Type)    */
 239 #define RANK2        52           /* RANK2      snd :: (Int,Type)          */
 240 #define EXIST        53           /* EXIST      snd :: (Int,Type)          */
 241 #define POLYREC      54           /* POLYREC:   snd :: (Int,Type)          */
 242 #define BIGLAM       55           /* BIGLAM:    snd :: (vars,patterns)     */
 243
 244 #define LABC         60           /* LABC:      snd :: (con,[(Vars,Type)]) */
 245 #define CONFLDS      61           /* CONFLDS:   snd :: (con,[Field])       */
 246 #define UPDFLDS      62           /* UPDFLDS:   snd :: (Exp,[con],[Field]) */
 247 #if TREX
 248 #define RECORD       63           /* RECORD:    snd :: [Val]               */
 249 #define EXTCASE      64           /* EXTCASE:   snd :: (Exp,Disc,Rhs)      */
 250 #define RECSEL       65           /* RECSEL:    snd :: Ext                 */
 251 #endif
 252
 253 #define QUALIDENT    70           /* Qualified identifier  snd :: (Id,Id)  */
 254 #define HIDDEN       71           /* hiding import list    snd :: [Entity] */
 255 #define MODULEENT    72           /* module in export list snd :: con      */
 256
 257 #define ONLY         75           /* ONLY:      snd :: Exp (used in parser)*/
 258 #define NEG          76           /* NEG:       snd :: Exp (used in parser)*/
 259
 260 #define IMPDEPS      78           /* IMPDEFS:   snd :: [Binding]           */
 261
 262 #define STGVAR       80           /* STGVAR     snd :: (StgRhs,info)       */
 263 #define STGAPP       81           /* STGAPP     snd :: (StgVar,[Arg])      */
 264 #define STGPRIM      82           /* STGPRIM    snd :: (PrimOp,[Arg])      */
 265 #define STGCON       83           /* STGCON     snd :: (StgCon,[Arg])      */
 266 #define PRIMCASE     84           /* PRIMCASE   snd :: (Expr,[PrimAlt])    */
 267
 268 /* Used when parsing GHC interface files */
 269 #define DICTAP       85           /* DICTTYPE   snd :: (QClassId,[Type])   */
 270
 271 /* Last constructor tag must be less than SPECMIN */
 272
 273 /* --------------------------------------------------------------------------
 274  * Special cell values:
 275  * ------------------------------------------------------------------------*/
 276
 277 #define SPECMIN      101
 278 #define isSpec(c)    (SPECMIN<=(c) && (c)<TUPMIN)/* Special cell values    */
 279
 280 #define NONE         101          /* Dummy stub                            */
 281 #define STAR         102          /* Representing the kind of types        */
 282 #if TREX
 283 #define ROW          103          /* Representing the kind of rows         */
 284 #endif
 285 #define WILDCARD     104          /* Wildcard pattern                      */
 286 #define SKOLEM       105          /* Skolem constant                       */
 287
 288 #define DOTDOT       106          /* ".." in import/export list            */
 289
 290 #define NAME         110          /* whatIs code for isName                */
 291 #define TYCON        111          /* whatIs code for isTycon               */
 292 #define CLASS        112          /* whatIs code for isClass               */
 293 #define MODULE       113          /* whatIs code for isModule              */
 294 #define INSTANCE     114          /* whatIs code for isInst                */
 295 #define TUPLE        115          /* whatIs code for tuple constructor     */
 296 #define OFFSET       116          /* whatis code for offset                */
 297 #define AP           117          /* whatIs code for application node      */
 298 #define CHARCELL     118          /* whatIs code for isChar                */
 299 #if TREX
 300 #define EXT          119          /* whatIs code for isExt                 */
 301 #endif
 302
 303 #define SIGDECL      120          /* Signature declaration                 */
 304 #define PREDEFINED   121          /* predefined name, not yet filled       */
 305
 306 #define DATATYPE     130          /* datatype type constructor             */
 307 #define NEWTYPE      131          /* newtype type constructor              */
 308 #define SYNONYM      132          /* synonym type constructor              */
 309 #define RESTRICTSYN  133          /* synonym with restricted scope         */
 310
 311 #define NODEPENDS    135          /* stop calculation of deps in type check*/
 312
 313 /* --------------------------------------------------------------------------
 314  * Tuple data/type constructors:
 315  * ------------------------------------------------------------------------*/
 316
 317 #define TUPMIN       201
 318 #if TREX
 319 #define isTuple(c)   (TUPMIN<=(c) && (c)<EXTMIN)
 320 #else
 321 #define isTuple(c)   (TUPMIN<=(c) && (c)<OFFMIN)
 322 #endif
 323 #define mkTuple(n)   (TUPMIN+(n))
 324 #define tupleOf(n)   ((Int)((n)-TUPMIN))
 325
 326 #if TREX
 327 #define EXTMIN       (TUPMIN+NUM_TUPLES)
 328 #define isExt(c)     (EXTMIN<=(c) && (c)<OFFMIN)
 329 #define extText(e)   tabExt[(e)-EXTMIN]
 330 #define extField(c)  arg(fun(c))
 331 #define extRow(c)    arg(c)
 332
 333 extern Text          DECTABLE(tabExt);
 334 extern Ext           mkExt Args((Text));
 335 #else
 336 #define mkExt(t) NIL
 337 #endif
 338
 339 /* --------------------------------------------------------------------------
 340  * Offsets: (generic types/stack offsets)
 341  * ------------------------------------------------------------------------*/
 342
 343 #if TREX
 344 #define OFFMIN       (EXTMIN+NUM_EXT)
 345 #else
 346 #define OFFMIN       (TUPMIN+NUM_TUPLES)
 347 #endif
 348 #define isOffset(c)  (OFFMIN<=(c) && (c)<MODMIN)
 349 #define offsetOf(c)  ((c)-OFFMIN)
 350 #define mkOffset(o)  (OFFMIN+(o))
 351
 352 /* --------------------------------------------------------------------------
 353  * Modules:
 354  * ------------------------------------------------------------------------*/
 355
 356 #define MODMIN        (OFFMIN+NUM_OFFSETS)
 357
 358 #define isModule(c)   (MODMIN<=(c) && (c)<TYCMIN)
 359 #define mkModule(n)   (MODMIN+(n))
 360 #define module(n)     tabModule[(n)-MODMIN]
 361
 362 /* Under Haskell 1.3, the list of qualified imports is always a subset
 363  * of the list of unqualified imports.  For simplicity and flexibility,
 364  * we do not attempt to exploit this fact - when a module is imported
 365  * unqualified, it is added to both the qualified and unqualified
 366  * import lists.
 367  * Similarily, Haskell 1.3 does not allow a constructor to be imported
 368  * or exported without exporting the type it belongs to but the export
 369  * list is just a flat list of Texts (before static analysis) or
 370  * Tycons, Names and Classes (after static analysis).
 371  */
 372 struct Module {
 373     Text  text;
 374     /* Lists of top level objects (local defns + imports)                  */
 375     List  tycons;
 376     List  names;
 377     List  classes;
 378     List  exports; /* [ Entity | (Entity, NIL|DOTDOT) ] */
 379     /* List of qualified imports.  Used both during compilation and when
 380      * evaluating an expression in the context of the current module.
 381      */
 382     List  qualImports;
 383     ObjectFile objectFile; /* usually unused */
 384 };
 385
 386 extern Module currentModule;           /* Module currently being processed */
 387 extern struct Module DECTABLE(tabModule);
 388
 389 extern Bool   isValidModule Args((Module));
 390 extern Module newModule     Args((Text));
 391 extern Module findModule    Args((Text));
 392 extern Module findModid     Args((Cell));
 393 extern Void   setCurrModule Args((Module));
 394
 395 /* --------------------------------------------------------------------------
 396  * Type constructor names:
 397  * ------------------------------------------------------------------------*/
 398
 399 #define TYCMIN       (MODMIN+NUM_MODULE)
 400 #define isTycon(c)   (TYCMIN<=(c) && (c)<NAMEMIN)
 401 #define mkTycon(n)   (TCMIN+(n))
 402 #define tycon(n)     tabTycon[(n)-TYCMIN]
 403
 404 struct strTycon {
 405     Text  text;
 406     Int   line;
 407     Module mod;                         /* module that defines it          */
 408     Int   arity;
 409     Kind  kind;                         /* kind (includes arity) of Tycon  */
 410     Cell  what;                         /* DATATYPE/SYNONYM/RESTRICTSYN... */
 411     Cell  defn;
 412     Name  conToTag;  /* used in derived code */
 413     Name  tagToCon;
 414     Tycon nextTyconHash;
 415 };
 416
 417 extern struct strTycon DECTABLE(tabTycon);
 418
 419 extern Tycon newTycon     Args((Text));
 420 extern Tycon findTycon    Args((Text));
 421 extern Tycon addTycon     Args((Tycon));
 422 extern Tycon findQualTycon Args((Cell));
 423 extern Tycon addPrimTycon  Args((Text,Kind,Int,Cell,Cell));
 424
 425 #define isSynonym(h)    (isTycon(h) && tycon(h).what==SYNONYM)
 426 #define mkPolyType(n,t) pair(POLYTYPE,pair(n,t))
 427 #define isPolyType(t)   (isPair(t) && fst(t)==POLYTYPE)
 428 #define polySigOf(t)    fst(snd(t))
 429 #define monotypeOf(t)   snd(snd(t))
 430
 431 /* --------------------------------------------------------------------------
 432  * Globally defined name values:
 433  * ------------------------------------------------------------------------*/
 434
 435 #define NAMEMIN      (TYCMIN+NUM_TYCON)
 436 #define isName(c)    (NAMEMIN<=(c) && (c)<INSTMIN)
 437 #define mkName(n)    (NAMEMIN+(n))
 438 #define name(n)      tabName[(n)-NAMEMIN]
 439
 440 struct strName {
 441     Text   text;
 442     Int    line;
 443     Module mod;                         /* module that defines it          */
 444     Int    arity;
 445     Int    number;
 446     Cell   type;
 447     Cell   defn;
 448     Cell   stgVar;        /* really StgVar   */
 449     const void*  primop;  /* really StgPrim* */
 450     Name   nextNameHash;
 451 };
 452
 453 extern int numNames Args(( Void ));
 454
 455 extern struct strName DECTABLE(tabName);
 456
 457 /* The number field in a name is used to distinguish various kinds of name:
 458  *   mfunNo(i) = code for member function, offset i
 459  *               members that are sole elements of dict use mfunNo(0)
 460  *               members of dicts with more than one elem use mfunNo(n), n>=1
 461  *   EXECNAME  = code for executable name (bytecodes or primitive)
 462  *   SELNAME   = code for selector function
 463  *   DFUNNAME  = code for dictionary builder or selector
 464  *   cfunNo(i) = code for data constructor
 465  *               datatypes with only one constructor uses cfunNo(0)
 466  *               datatypes with multiple constructors use cfunNo(n), n>=1
 467  */
 468
 469 #define EXECNAME        0
 470 #define SELNAME         1
 471 #define DFUNNAME        2
 472 #define CFUNNAME        3
 473
 474 #define isSfun(n)       (name(n).number==SELNAME)
 475 #define isDfun(n)       (name(n).number==DFUNNAME)
 476
 477 #define isCfun(n)       (name(n).number>=CFUNNAME)
 478 #define cfunOf(n)       (name(n).number-CFUNNAME)
 479 #define cfunNo(i)       ((i)+CFUNNAME)
 480 #define hasCfun(cs)     (nonNull(cs) && isCfun(hd(cs)))
 481
 482 #define isMfun(n)       (name(n).number<0)
 483 #define mfunOf(n)       ((-1)-name(n).number)
 484 #define mfunNo(i)       ((-1)-(i))
 485
 486 extern Name   newName      Args((Text));
 487 extern Name   findName     Args((Text));
 488 extern Name   addName      Args((Name));
 489 extern Name   findQualName Args((Int,Cell));
 490 extern Name   addPrimCfun  Args((Text,Int,Int,Int));
 491 extern Int    sfunPos      Args((Name,Name));
 492
 493 /* --------------------------------------------------------------------------
 494  * Type class values:
 495  * ------------------------------------------------------------------------*/
 496
 497 #define INSTMIN      (NAMEMIN+NUM_NAME)          /* instances              */
 498 #define isInst(c)    (INSTMIN<=(c) && (c)<CLASSMIN)
 499 #define mkInst(n)    (INSTMIN+(n))
 500 #define instOf(c)    ((Int)((c)-INSTMIN))
 501 #define inst(in)     tabInst[(in)-INSTMIN]
 502
 503 struct strInst {
 504     Class c;                            /* class C                         */
 505     Int   line;
 506     Module mod;                         /* module that defines it          */
 507     Kinds kinds;                        /* Kinds of variables in head      */
 508     Cell  head;                         /* :: Pred                         */
 509     List  specifics;                    /* :: [Pred]                       */
 510     Int   numSpecifics;                 /* length(specifics)               */
 511     List  implements;
 512     Name  builder;                      /* Dictionary constructor function */
 513 };
 514
 515 /* a predicate (an element :: Pred) is an application of a Class to one or
 516  * more type expressions
 517  */
 518
 519 #define CLASSMIN     (INSTMIN+NUM_INSTS)
 520 #define isClass(c)   (CLASSMIN<=(c) && (c)<CHARMIN)
 521 #define mkClass(n)   (CLASSMIN+(n))
 522 #define cclass(n)    tabClass[(n)-CLASSMIN]
 523
 524 struct strClass {
 525     Text  text;                         /* Name of class                   */
 526     Int   line;                         /* Line where declaration begins   */
 527     Module mod;                         /* module that defines it          */
 528     Int   level;                        /* Level in class hierarchy        */
 529     Int   arity;                        /* Number of arguments             */
 530     Kinds kinds;                        /* Kinds of constructors in class  */
 531     Cell  head;                         /* Head of class                   */
 532     Name  dcon;                         /* Dictionay constructor function  */
 533     List  supers;                       /* :: [Pred]                       */
 534     Int   numSupers;                    /* length(supers)                  */
 535     List  dsels;                        /* Superclass dictionary selectors */
 536     List  members;                      /* :: [Name]                       */
 537     Int   numMembers;                   /* length(members)                 */
 538     Name  dbuild;                       /* Default dictionary builder      */
 539     List  defaults;                     /* :: [Name]                       */
 540     List  instances;                    /* :: [Inst]                       */
 541 };
 542
 543 extern struct strClass    DECTABLE(tabClass);
 544 extern struct strInst far *tabInst;
 545
 546 extern Class newClass      Args((Text));
 547 extern Class classMax      Args((Void));
 548 extern Class findClass     Args((Text));
 549 extern Class addClass      Args((Class));
 550 extern Class findQualClass Args((Cell));
 551 extern Inst  newInst       Args((Void));
 552 extern Inst  findFirstInst Args((Tycon));
 553 extern Inst  findNextInst  Args((Tycon,Inst));
 554
 555 /* --------------------------------------------------------------------------
 556  * Character values:
 557  * ------------------------------------------------------------------------*/
 558
 559 #define CHARMIN      (CLASSMIN+NUM_CLASSES)
 560 #define MAXCHARVAL   (NUM_CHARS-1)
 561 #define isChar(c)    (CHARMIN<=(c) && (c)<INTMIN)
 562 #define charOf(c)    ((Char)(c-CHARMIN))
 563 #define mkChar(c)    ((Cell)(CHARMIN+((unsigned)((c)%NUM_CHARS))))
 564
 565 /* --------------------------------------------------------------------------
 566  * Small Integer values:
 567  * ------------------------------------------------------------------------*/
 568
 569 #define INTMIN       (CHARMIN+NUM_CHARS)
 570 #define INTMAX       MAXPOSINT
 571 #define isSmall(c)   (INTMIN<=(c))
 572 #define INTZERO      (INTMIN/2 + INTMAX/2)
 573 #define mkDigit(c)   ((Cell)((c)+INTMIN))
 574 #define digitOf(c)   ((Int)((c)-INTMIN))
 575
 576 extern  Bool isInt    Args((Cell));
 577 extern  Int  intOf    Args((Cell));
 578 extern  Cell mkInt    Args((Int));
 579
 580 /* --------------------------------------------------------------------------
 581  * Implementation of triples:
 582  * ------------------------------------------------------------------------*/
 583
 584 #define triple(x,y,z) pair(x,pair(y,z))
 585 #define fst3(c)      fst(c)
 586 #define snd3(c)      fst(snd(c))
 587 #define thd3(c)      snd(snd(c))
 588
 589 /* --------------------------------------------------------------------------
 590  * Implementation of lists:
 591  * ------------------------------------------------------------------------*/
 592
 593 #define NIL          0
 594 #define isNull(c)    ((c)==NIL)
 595 #define nonNull(c)   (c)
 596 #define cons(x,xs)   pair(x,xs)
 597 #define singleton(x)     cons(x,NIL)
 598 #define doubleton(x,y)   cons(x,cons(y,NIL))
 599 #define tripleton(x,y,z) cons(x,cons(y,cons(z,NIL)))
 600 #define hd(c)        fst(c)
 601 #define tl(c)        snd(c)
 602
 603 extern  Int          length       Args((List));
 604 extern  List         appendOnto   Args((List,List)); /* destructive     */
 605 extern  List         revDupOnto   Args((List,List)); /* non-destructive */
 606 extern  List         dupListOnto  Args((List,List)); /* non-destructive */
 607 extern  List         revOnto      Args((List,List)); /* destructive     */
 608 #define reverse(xs)  revDupOnto((xs),NIL)            /* non-destructive */
 609 #define dupList(xs)  dupListOnto((xs),NIL)           /* non-destructive */
 610 #define rev(xs)      revOnto((xs),NIL)               /* destructive     */
 611 extern  Cell         cellIsMember Args((Cell,List));
 612 extern  Cell         cellAssoc    Args((Cell,List));
 613 extern  Cell         cellRevAssoc Args((Cell,List));
 614 extern  Bool         eqList       Args((List,List));
 615 extern  Cell         varIsMember  Args((Text,List));
 616 extern  Cell         intIsMember  Args((Int,List));
 617 extern  List         replicate    Args((Int,Cell));
 618 extern  List         diffList     Args((List,List)); /* destructive     */
 619 extern  List         deleteCell   Args((List,Cell)); /* non-destructive */
 620 extern  List         take         Args((Int,List));  /* destructive     */
 621 extern  List         splitAt      Args((Int,List));  /* non-destructive */
 622 extern  Cell         nth          Args((Int,List));
 623 extern  List         removeCell   Args((Cell,List)); /* destructive     */
 624
 625 /* The following macros provide `inline expansion' of some common ways of
 626  * traversing, using and modifying lists:
 627  *
 628  * N.B. We use the names _f, _a, _xs, Zs, in an attempt to avoid clashes
 629  *      with identifiers used elsewhere.
 630  */
 631
 632 #define mapBasic(_init,_step)     {List Zs=(_init);\
 633                                    for(;nonNull(Zs);Zs=tl(Zs))  \
 634                                    _step;}
 635 #define mapModify(_init,_step)    mapBasic(_init,hd(Zs)=_step)
 636
 637 #define mapProc(_f,_xs)           mapBasic(_xs,_f(hd(Zs)))
 638 #define map1Proc(_f,_a,_xs)       mapBasic(_xs,_f(_a,hd(Zs)))
 639 #define map2Proc(_f,_a,_b,_xs)    mapBasic(_xs,_f(_a,_b,hd(Zs)))
 640 #define map3Proc(_f,_a,_b,_c,_xs) mapBasic(_xs,_f(_a,_b,_c,hd(Zs)))
 641
 642 #define mapOver(_f,_xs)           mapModify(_xs,_f(hd(Zs)))
 643 #define map1Over(_f,_a,_xs)       mapModify(_xs,_f(_a,hd(Zs)))
 644 #define map2Over(_f,_a,_b,_xs)    mapModify(_xs,_f(_a,_b,hd(Zs)))
 645 #define map3Over(_f,_a,_b,_c,_xs) mapModify(_xs,_f(_a,_b,_c,hd(Zs)))
 646
 647 /* This is just what you want for functions with accumulating parameters */
 648 #define mapAccum(_f,_acc,_xs)           mapBasic(_xs,_acc=_f(_acc,hd(Zs)))
 649 #define map1Accum(_f,_acc,_a,_xs)       mapBasic(_xs,_acc=_f(_acc,_a,hd(Zs)))
 650 #define map2Accum(_f,_acc,_a,_b,_xs)    mapBasic(_xs,_acc=_f(_acc,_a,_b,hd(Zs)))
 651 #define map3Accum(_f,_acc,_a,_b,_c,_xs) mapBasic(_xs,_acc=_f(_acc,_a,_b,_c,hd(Zs)))
 652
 653 /* --------------------------------------------------------------------------
 654  * Implementation of function application nodes:
 655  * ------------------------------------------------------------------------*/
 656
 657 #define ap(f,x)      pair(f,x)
 658 #define ap1(f,x)     ap(f,x)
 659 #define ap2(f,x,y)   ap(ap(f,x),y)
 660 #define ap3(f,x,y,z) ap(ap(ap(f,x),y),z)
 661 #define fun(c)       fst(c)
 662 #define arg(c)       snd(c)
 663 #define isAp(c)      (isPair(c) && !isTag(fst(c)))
 664 extern  Cell         getHead     Args((Cell));
 665 extern  List         getArgs     Args((Cell));
 666 extern  Int          argCount;
 667 extern  Cell         nthArg      Args((Int,Cell));
 668 extern  Int          numArgs     Args((Cell));
 669 extern  Cell         applyToArgs Args((Cell,List));
 670
 671 /* --------------------------------------------------------------------------
 672  * Stack implementation:
 673  *
 674  * NB: Use of macros makes order of evaluation hard to predict.
 675  *     For example, "push(1+pop());" doesn't increment TOS.
 676  * ------------------------------------------------------------------------*/
 677
 678 extern  Cell DECTABLE(cellStack);
 679 extern  StackPtr sp;
 680
 681 #define clearStack() sp=(-1)
 682 #define stackEmpty() (sp==(-1))
 683 #define stack(p)     cellStack[p]
 684 #define chkStack(n)  if (sp>=NUM_STACK-(n)) hugsStackOverflow()
 685 #define push(c)      \
 686   do {               \
 687     chkStack(1);     \
 688     onto(c);         \
 689   } while (0)
 690 #define onto(c)      stack(++sp)=(c)
 691 #define pop()        stack(sp--)
 692 #define drop()       sp--
 693 #define top()        stack(sp)
 694 #define pushed(n)    stack(sp-(n))
 695
 696 extern  Void hugsStackOverflow Args((Void));
 697
 698 /* --------------------------------------------------------------------------
 699  * Script file control:
 700  * The implementation of script file storage is hidden.
 701  * ------------------------------------------------------------------------*/
 702
 703 extern Script      startNewScript   Args((String));
 704 extern Module      lastModule       Args((Void));
 705 extern Script      scriptThisName   Args((Name));
 706 extern Script      scriptThisTycon  Args((Tycon));
 707 extern Script      scriptThisInst   Args((Inst));
 708 extern Script      scriptThisClass  Args((Class));
 709 extern String      fileOfModule     Args((Module));
 710 extern Void        dropScriptsFrom  Args((Script));
 711
 712 /* --------------------------------------------------------------------------
 713  * Misc:
 714  * ------------------------------------------------------------------------*/
 715
 716 extern  Void   setLastExpr      Args((Cell));
 717 extern  Cell   getLastExpr      Args((Void));
 718 extern  List   addTyconsMatching Args((String,List));
 719 extern  List   addNamesMatching Args((String,List));
 720
 721 /*-------------------------------------------------------------------------*/