ghc/interpreter/link.c

   1
   2 /* --------------------------------------------------------------------------
   3  * Load symbols required from the Prelude
   4  *
   5  * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
   6  * Yale Haskell Group, and the Oregon Graduate Institute of Science and
   7  * Technology, 1994-1999, All rights reserved.  It is distributed as
   8  * free software under the license in the file "License", which is
   9  * included in the distribution.
  10  *
  11  * $RCSfile: link.c,v $
  12  * $Revision: 1.54 $
  13  * $Date: 2000/03/23 14:54:21 $
  14  * ------------------------------------------------------------------------*/
  15
  16 #include "hugsbasictypes.h"
  17 #include "storage.h"
  18 #include "connect.h"
  19 #include "errors.h"
  20 #include "Assembler.h"                  /* for asmPrimOps and AsmReps      */
  21 #include "Rts.h"                        /* to make Prelude.h palatable     */
  22 #include "Prelude.h"                    /* for fixupRTStoPreludeRefs       */
  23
  24
  25 Type typeArrow;                         /* Function spaces                 */
  26
  27 Type typeChar;
  28 Type typeInt;
  29 Type typeInteger;
  30 Type typeWord;
  31 Type typeAddr;
  32 Type typePrimArray;
  33 Type typePrimByteArray;
  34 Type typeRef;
  35 Type typePrimMutableArray;
  36 Type typePrimMutableByteArray;
  37 Type typeFloat;
  38 Type typeDouble;
  39 Type typeStable;
  40 Type typeThreadId;
  41 Type typeMVar;
  42 #ifdef PROVIDE_WEAK
  43 Type typeWeak;
  44 #endif
  45 #ifdef PROVIDE_FOREIGN
  46 Type typeForeign;
  47 #endif
  48
  49 Type typeList;
  50 Type typeUnit;
  51 Type typeString;
  52 Type typeBool;
  53 Type typeST;
  54 Type typeIO;
  55 Type typeException;
  56
  57 Class classEq;                          /* `standard' classes              */
  58 Class classOrd;
  59 Class classShow;
  60 Class classRead;
  61 Class classIx;
  62 Class classEnum;
  63 Class classBounded;
  64
  65 Class classReal;                        /* `numeric' classes               */
  66 Class classIntegral;
  67 Class classRealFrac;
  68 Class classRealFloat;
  69 Class classFractional;
  70 Class classFloating;
  71 Class classNum;
  72 Class classMonad;                       /* Monads and monads with a zero   */
  73
  74 List stdDefaults;                       /* standard default values         */
  75
  76 Name nameTrue;
  77 Name nameFalse;            /* primitive boolean constructors  */
  78 Name nameNil;
  79 Name nameCons;             /* primitive list constructors     */
  80 Name nameUnit;                          /* primitive Unit type constructor */
  81
  82 Name nameEq;
  83 Name nameFromInt;
  84 Name nameFromDouble;       /* coercion of numerics            */
  85 Name nameFromInteger;
  86 Name nameReturn;
  87 Name nameBind;             /* for translating monad comps     */
  88 Name nameZero;                          /* for monads with a zero          */
  89
  90 Name nameId;
  91 Name nameShow;
  92 Name namePutStr;
  93 Name nameRunIO_toplevel;
  94 Name namePrint;
  95
  96 Name nameOtherwise;
  97 Name nameUndefined;                     /* generic undefined value         */
  98 Name namePmSub;
  99 Name namePMFail;
 100 Name nameEqChar;
 101 Name namePmInt;
 102 Name namePmInteger;
 103 Name namePmDouble;
 104 Name namePmLe;
 105 Name namePmSubtract;
 106 Name namePmFromInteger;
 107 Name nameMkIO;
 108 Name nameUnpackString;
 109 Name nameError;
 110 Name nameInd;
 111 Name nameCreateAdjThunk;
 112
 113 Name nameAnd;
 114 Name nameCompAux;
 115 Name nameRangeSize;
 116 Name nameComp;
 117 Name nameShowField;
 118 Name nameApp;
 119 Name nameShowParen;
 120 Name nameReadParen;
 121 Name nameLex;
 122 Name nameReadField;
 123 Name nameFlip;
 124
 125 Name namePrimSeq;
 126 Name namePrimCatch;
 127 Name namePrimRaise;
 128 Name namePrimTakeMVar;
 129
 130 Name nameFromTo;
 131 Name nameFromThen;
 132 Name nameFrom;
 133 Name nameFromThenTo;
 134 Name nameNegate;
 135
 136 Name nameAssert;
 137 Name nameAssertError;
 138 Name nameTangleMessage;
 139 Name nameIrrefutPatError;
 140 Name nameNoMethodBindingError;
 141 Name nameNonExhaustiveGuardsError;
 142 Name namePatError;
 143 Name nameRecSelError;
 144 Name nameRecConError;
 145 Name nameRecUpdError;
 146
 147 /* these names are required before we've had a chance to do the right thing */
 148 Name nameSel;
 149 Name nameUnsafeUnpackCString;
 150
 151 /* constructors used during translation and codegen */
 152 Name nameMkC;                           /* Char#        -> Char           */
 153 Name nameMkI;                           /* Int#         -> Int            */
 154 Name nameMkInteger;                     /* Integer#     -> Integer        */
 155 Name nameMkW;                           /* Word#        -> Word           */
 156 Name nameMkA;                           /* Addr#        -> Addr            */
 157 Name nameMkF;                           /* Float#       -> Float           */
 158 Name nameMkD;                           /* Double#      -> Double          */
 159 Name nameMkPrimArray;
 160 Name nameMkPrimByteArray;
 161 Name nameMkRef;
 162 Name nameMkPrimMutableArray;
 163 Name nameMkPrimMutableByteArray;
 164 Name nameMkStable;                      /* StablePtr# a -> StablePtr a     */
 165 Name nameMkThreadId;                    /* ThreadId#    -> ThreadId        */
 166 Name nameMkPrimMVar;                    /* MVar# a      -> MVar a          */
 167 #ifdef PROVIDE_WEAK
 168 Name nameMkWeak;                        /* Weak# a      -> Weak a          */
 169 #endif
 170 #ifdef PROVIDE_FOREIGN
 171 Name nameMkForeign;                     /* ForeignObj#  -> ForeignObj      */
 172 #endif
 173
 174
 175
 176 Name nameMinBnd;
 177 Name nameMaxBnd;
 178 Name nameCompare;
 179 Name nameShowsPrec;
 180 Name nameIndex;
 181 Name nameReadsPrec;
 182 Name nameRange;
 183 Name nameEQ;
 184 Name nameInRange;
 185 Name nameGt;
 186 Name nameLe;
 187 Name namePlus;
 188 Name nameMult;
 189 Name nameMFail;
 190 Type typeOrdering;
 191 Module modulePrelude;
 192 Name nameMap;
 193 Name nameMinus;
 194
 195
 196 /* --------------------------------------------------------------------------
 197  * Frequently used type skeletons:
 198  * ------------------------------------------------------------------------*/
 199
 200 Type  arrow;                     /* mkOffset(0) -> mkOffset(1)      */
 201 Type  boundPair;                 /* (mkOffset(0),mkOffset(0))       */
 202 Type  listof;                    /* [ mkOffset(0) ]                 */
 203 Type  typeVarToVar;              /* mkOffset(0) -> mkOffset(0)      */
 204
 205 Cell  predNum;                   /* Num (mkOffset(0))               */
 206 Cell  predFractional;            /* Fractional (mkOffset(0))        */
 207 Cell  predIntegral;              /* Integral (mkOffset(0))          */
 208 Kind  starToStar;                /* Type -> Type                    */
 209 Cell  predMonad;                 /* Monad (mkOffset(0))             */
 210 Type  typeProgIO;                /* IO a                            */
 211
 212
 213 /* --------------------------------------------------------------------------
 214  *
 215  * ------------------------------------------------------------------------*/
 216
 217 static Tycon linkTycon ( String s );
 218 static Tycon linkClass ( String s );
 219 static Name  linkName  ( String s );
 220 static Name  predefinePrim ( String s );
 221
 222
 223 static Tycon linkTycon( String s )
 224 {
 225     Tycon tc = findTycon(findText(s));
 226     if (nonNull(tc)) return tc;
 227     if (combined) {
 228        tc = findTyconInAnyModule(findText(s));
 229        if (nonNull(tc)) return tc;
 230     }
 231 fprintf(stderr, "frambozenvla!  unknown tycon %s\n", s );
 232 return NIL;
 233     ERRMSG(0) "Prelude does not define standard type \"%s\"", s
 234     EEND;
 235 }
 236
 237 static Class linkClass( String s )
 238 {
 239     Class cc = findClass(findText(s));
 240     if (nonNull(cc)) return cc;
 241     if (combined) {
 242        cc = findClassInAnyModule(findText(s));
 243        if (nonNull(cc)) return cc;
 244     }
 245 fprintf(stderr, "frambozenvla!  unknown class %s\n", s );
 246 return NIL;
 247     ERRMSG(0) "Prelude does not define standard class \"%s\"", s
 248     EEND;
 249 }
 250
 251 static Name linkName( String s )
 252 {
 253     Name n = findName(findText(s));
 254     if (nonNull(n)) return n;
 255     if (combined) {
 256        n = findNameInAnyModule(findText(s));
 257        if (nonNull(n)) return n;
 258     }
 259 fprintf(stderr, "frambozenvla!  unknown  name %s\n", s );
 260 return NIL;
 261     ERRMSG(0) "Prelude does not define standard name \"%s\"", s
 262     EEND;
 263 }
 264
 265 static Name predefinePrim ( String s )
 266 {
 267     Name nm;
 268     Text t = findText(s);
 269     nm = findName(t);
 270     if (nonNull(nm)) {
 271        //fprintf(stderr, "predefinePrim: %s already exists\n", s );
 272     } else {
 273        nm = newName(t,NIL);
 274        name(nm).defn=PREDEFINED;
 275     }
 276     return nm;
 277 }
 278
 279
 280 /* --------------------------------------------------------------------------
 281  *
 282  * ------------------------------------------------------------------------*/
 283
 284 /* In standalone mode, linkPreludeTC, linkPreludeCM and linkPrimNames
 285    are called, in that order, during static analysis of Prelude.hs.
 286    In combined mode such an analysis does not happen.  Instead these
 287    calls will be made as a result of a call link(POSTPREL).
 288
 289    linkPreludeTC, linkPreludeCM and linkPreludeNames are needed in both
 290    standalone and combined modes.
 291 */
 292
 293
 294 Void linkPreludeTC(void) {              /* Hook to tycons and classes in   */
 295     static Bool initialised = FALSE;    /* prelude when first loaded       */
 296     if (!initialised) {
 297         Int i;
 298         initialised = TRUE;
 299         setCurrModule(modulePrelude);
 300
 301         typeChar                 = linkTycon("Char");
 302         typeInt                  = linkTycon("Int");
 303         typeInteger              = linkTycon("Integer");
 304         typeWord                 = linkTycon("Word");
 305         typeAddr                 = linkTycon("Addr");
 306         typePrimArray            = linkTycon("PrimArray");
 307         typePrimByteArray        = linkTycon("PrimByteArray");
 308         typeRef                  = linkTycon("STRef");
 309         typePrimMutableArray     = linkTycon("PrimMutableArray");
 310         typePrimMutableByteArray = linkTycon("PrimMutableByteArray");
 311         typeFloat                = linkTycon("Float");
 312         typeDouble               = linkTycon("Double");
 313         typeStable               = linkTycon("StablePtr");
 314 #       ifdef PROVIDE_WEAK
 315         typeWeak                 = linkTycon("Weak");
 316 #       endif
 317 #       ifdef PROVIDE_FOREIGN
 318         typeForeign              = linkTycon("ForeignObj");
 319 #       endif
 320         typeThreadId             = linkTycon("ThreadId");
 321         typeMVar                 = linkTycon("MVar");
 322         typeBool                 = linkTycon("Bool");
 323         typeST                   = linkTycon("ST");
 324         typeIO                   = linkTycon("IO");
 325         typeException            = linkTycon("Exception");
 326         typeString               = linkTycon("String");
 327         typeOrdering             = linkTycon("Ordering");
 328
 329         classEq                  = linkClass("Eq");
 330         classOrd                 = linkClass("Ord");
 331         classIx                  = linkClass("Ix");
 332         classEnum                = linkClass("Enum");
 333         classShow                = linkClass("Show");
 334         classRead                = linkClass("Read");
 335         classBounded             = linkClass("Bounded");
 336         classReal                = linkClass("Real");
 337         classIntegral            = linkClass("Integral");
 338         classRealFrac            = linkClass("RealFrac");
 339         classRealFloat           = linkClass("RealFloat");
 340         classFractional          = linkClass("Fractional");
 341         classFloating            = linkClass("Floating");
 342         classNum                 = linkClass("Num");
 343         classMonad               = linkClass("Monad");
 344
 345         stdDefaults              = NIL;
 346         stdDefaults              = cons(typeDouble,stdDefaults);
 347         stdDefaults              = cons(typeInteger,stdDefaults);
 348
 349         predNum                  = ap(classNum,aVar);
 350         predFractional           = ap(classFractional,aVar);
 351         predIntegral             = ap(classIntegral,aVar);
 352         predMonad                = ap(classMonad,aVar);
 353         typeProgIO               = ap(typeIO,aVar);
 354
 355         nameMkC                  = addPrimCfunREP(findText("C#"),1,0,CHAR_REP);
 356         nameMkI                  = addPrimCfunREP(findText("I#"),1,0,INT_REP);
 357         nameMkW                  = addPrimCfunREP(findText("W#"),1,0,WORD_REP);
 358         nameMkA                  = addPrimCfunREP(findText("A#"),1,0,ADDR_REP);
 359         nameMkF                  = addPrimCfunREP(findText("F#"),1,0,FLOAT_REP);
 360         nameMkD                  = addPrimCfunREP(findText("D#"),1,0,DOUBLE_REP);
 361         nameMkStable             = addPrimCfunREP(findText("Stable#"),1,0,STABLE_REP);
 362         nameMkThreadId           = addPrimCfunREP(findText("ThreadId#"),1,0,THREADID_REP);
 363
 364 #       ifdef PROVIDE_FOREIGN
 365         nameMkForeign            = addPrimCfunREP(findText("Foreign#"),1,0,0);
 366 #       endif
 367 #       ifdef PROVIDE_WEAK
 368         nameMkWeak               = addPrimCfunREP(findText("Weak#"),1,0,0);
 369 #       endif
 370         nameMkPrimArray          = addPrimCfunREP(findText("PrimArray#"),1,0,0);
 371         nameMkPrimByteArray      = addPrimCfunREP(findText("PrimByteArray#"),1,0,0);
 372         nameMkRef                = addPrimCfunREP(findText("STRef#"),1,0,0);
 373         nameMkPrimMutableArray   = addPrimCfunREP(findText("PrimMutableArray#"),1,0,0);
 374         nameMkPrimMutableByteArray = addPrimCfunREP(findText("PrimMutableByteArray#"),1,0,0);
 375         nameMkPrimMVar           = addPrimCfunREP(findText("MVar#"),1,0,0);
 376         nameMkInteger            = addPrimCfunREP(findText("Integer#"),1,0,0);
 377
 378         if (!combined) {
 379            name(namePrimSeq).type   = primType(MONAD_Id, "ab", "b");
 380            name(namePrimCatch).type = primType(MONAD_Id, "aH", "a");
 381            name(namePrimRaise).type = primType(MONAD_Id, "E", "a");
 382
 383            /* This is a lie.  For a more accurate type of primTakeMVar
 384               see ghc/interpreter/lib/Prelude.hs.
 385            */
 386            name(namePrimTakeMVar).type = primType(MONAD_Id, "rbc", "d");
 387         }
 388
 389         if (!combined) {
 390            for (i=2; i<=NUM_DTUPLES; i++) {/* Add derived instances of tuples */
 391                addTupInst(classEq,i);
 392                addTupInst(classOrd,i);
 393                addTupInst(classIx,i);
 394                addTupInst(classShow,i);
 395                addTupInst(classRead,i);
 396                addTupInst(classBounded,i);
 397            }
 398         }
 399     }
 400 }
 401
 402 Void linkPreludeCM(void) {              /* Hook to cfuns and mfuns in      */
 403     static Bool initialised = FALSE;    /* prelude when first loaded       */
 404     if (!initialised) {
 405         Int i;
 406         initialised = TRUE;
 407
 408         setCurrModule(modulePrelude);
 409
 410         /* constructors */
 411         nameFalse        = linkName("False");
 412         nameTrue         = linkName("True");
 413
 414         /* members */
 415         nameEq           = linkName("==");
 416         nameFromInt      = linkName("fromInt");
 417         nameFromInteger  = linkName("fromInteger");
 418         nameReturn       = linkName("return");
 419         nameBind         = linkName(">>=");
 420         nameMFail        = linkName("fail");
 421         nameLe           = linkName("<=");
 422         nameGt           = linkName(">");
 423         nameShowsPrec    = linkName("showsPrec");
 424         nameReadsPrec    = linkName("readsPrec");
 425         nameEQ           = linkName("EQ");
 426         nameCompare      = linkName("compare");
 427         nameMinBnd       = linkName("minBound");
 428         nameMaxBnd       = linkName("maxBound");
 429         nameRange        = linkName("range");
 430         nameIndex        = linkName("index");
 431         namePlus         = linkName("+");
 432         nameMult         = linkName("*");
 433         nameRangeSize    = linkName("rangeSize");
 434         nameInRange      = linkName("inRange");
 435         nameMinus        = linkName("-");
 436         /* These come before calls to implementPrim */
 437         if (!combined) {
 438            for(i=0; i<NUM_TUPLES; ++i) {
 439                if (i != 1) implementTuple(i);
 440            }
 441         }
 442     }
 443 }
 444
 445 Void linkPrimNames ( void ) {        /* Hook to names defined in Prelude */
 446     static Bool initialised = FALSE;
 447
 448     if (!initialised) {
 449         initialised = TRUE;
 450
 451         setCurrModule(modulePrelude);
 452
 453         /* primops */
 454         nameMkIO           = linkName("hugsprimMkIO");
 455
 456         if (!combined) {
 457           Int i;
 458           for (i=0; asmPrimOps[i].name; ++i) {
 459             Text t = findText(asmPrimOps[i].name);
 460             Name n = findName(t);
 461             if (isNull(n)) {
 462               n = newName(t,NIL);
 463               name(n).line   = 0;
 464               name(n).defn   = NIL;
 465               name(n).type   = primType(asmPrimOps[i].monad,
 466                                         asmPrimOps[i].args,
 467                                         asmPrimOps[i].results);
 468               name(n).arity  = strlen(asmPrimOps[i].args);
 469               name(n).primop = &(asmPrimOps[i]);
 470               implementPrim(n);
 471             } else {
 472               ERRMSG(0) "Link Error in Prelude, surplus definition of \"%s\"",
 473                                 asmPrimOps[i].name
 474               EEND;
 475               // Name already defined!
 476             }
 477           }
 478         }
 479
 480         /* static(tidyInfix)                        */
 481         nameNegate         = linkName("negate");
 482         /* user interface                           */
 483         nameRunIO_toplevel = linkName("hugsprimRunIO_toplevel");
 484         nameShow           = linkName("show");
 485         namePutStr         = linkName("putStr");
 486         namePrint          = linkName("print");
 487         /* desugar                                  */
 488         nameOtherwise      = linkName("otherwise");
 489         nameUndefined      = linkName("undefined");
 490         /* pmc                                      */
 491         namePmSub          = linkName("hugsprimPmSub");
 492         /* translator                               */
 493         nameEqChar         = linkName("hugsprimEqChar");
 494         nameCreateAdjThunk = linkName("hugsprimCreateAdjThunk");
 495         namePmInt          = linkName("hugsprimPmInt");
 496         namePmInteger      = linkName("hugsprimPmInteger");
 497         namePmDouble       = linkName("hugsprimPmDouble");
 498
 499         nameFromDouble     = linkName("fromDouble");
 500         namePmFromInteger = linkName("hugsprimPmFromInteger");
 501
 502         namePmSubtract    = linkName("hugsprimPmSubtract");
 503         namePmLe          = linkName("hugsprimPmLe");
 504
 505         if (!combined) {
 506            implementCfun ( nameCons, NIL );
 507            implementCfun ( nameNil, NIL );
 508            implementCfun ( nameUnit, NIL );
 509         }
 510     }
 511 }
 512
 513
 514 /* --------------------------------------------------------------------------
 515  *
 516  * ------------------------------------------------------------------------*/
 517
 518 /* ToDo: fix pFun (or eliminate its use) */
 519 #define pFun(n,s) n = predefinePrim(s)
 520
 521 Void linkControl(what)
 522 Int what; {
 523     Int i;
 524     switch (what) {
 525       //case EXIT : fooble();break;
 526         case RESET   :
 527         case MARK    :
 528                        break;
 529
 530         case POSTPREL: {
 531            Name nm;
 532            Module modulePrelBase = findModule(findText("PrelBase"));
 533            assert(nonNull(modulePrelBase));
 534            /* fprintf(stderr, "linkControl(POSTPREL)\n"); */
 535            setCurrModule(modulePrelude);
 536            linkPreludeTC();
 537            linkPreludeCM();
 538            linkPrimNames();
 539            fixupRTStoPreludeRefs ( lookupObjName );
 540
 541            nameUnpackString = linkName("hugsprimUnpackString");
 542            namePMFail       = linkName("hugsprimPmFail");
 543 assert(nonNull(namePMFail));
 544 #define xyzzy(aaa,bbb) aaa = linkName(bbb)
 545
 546
 547                /* pmc                                   */
 548                pFun(nameSel,            "_SEL");
 549
 550                /* strict constructors                   */
 551                xyzzy(nameFlip,           "flip"     );
 552
 553                /* parser                                */
 554                xyzzy(nameFromTo,         "enumFromTo");
 555                xyzzy(nameFromThenTo,     "enumFromThenTo");
 556                xyzzy(nameFrom,           "enumFrom");
 557                xyzzy(nameFromThen,       "enumFromThen");
 558
 559                /* deriving                              */
 560                xyzzy(nameApp,            "++");
 561                xyzzy(nameReadField,      "hugsprimReadField");
 562                xyzzy(nameReadParen,      "readParen");
 563                xyzzy(nameShowField,      "hugsprimShowField");
 564                xyzzy(nameShowParen,      "showParen");
 565                xyzzy(nameLex,            "lex");
 566                xyzzy(nameComp,           ".");
 567                xyzzy(nameAnd,            "&&");
 568                xyzzy(nameCompAux,        "hugsprimCompAux");
 569                xyzzy(nameMap,            "map");
 570
 571                /* implementTagToCon                     */
 572                xyzzy(nameError,          "hugsprimError");
 573
 574
 575            typeStable = linkTycon("Stable");
 576            typeRef    = linkTycon("IORef");
 577            // {Prim,PrimByte,PrimMutable,PrimMutableByte}Array ?
 578
 579            ifLinkConstrItbl ( nameFalse );
 580            ifLinkConstrItbl ( nameTrue );
 581            ifLinkConstrItbl ( nameNil );
 582            ifLinkConstrItbl ( nameCons );
 583
 584            /* PrelErr.hi doesn't give a type for error, alas.
 585               So error never appears in any symbol table.
 586               So we fake it by copying the table entry for
 587               hugsprimError -- which is just a call to error.
 588               Although we put it on the Prelude export list, we
 589               have to claim internally that it lives in PrelErr,
 590               so that the correct symbol (PrelErr_error_closure)
 591               is referred to.
 592               Big Big Sigh.
 593            */
 594            nm            = newName ( findText("error"), NIL );
 595            name(nm)      = name(nameError);
 596            name(nm).mod  = findModule(findText("PrelErr"));
 597            name(nm).text = findText("error");
 598            setCurrModule(modulePrelude);
 599            module(modulePrelude).exports
 600               = cons ( nm, module(modulePrelude).exports );
 601
 602            /* The GHC prelude doesn't seem to export Addr.  Add it to the
 603               export list for the sake of compatibility with standalone mode.
 604            */
 605            module(modulePrelude).exports
 606               = cons ( pair(typeAddr,DOTDOT),
 607                        module(modulePrelude).exports );
 608            addTycon(typeAddr);
 609
 610            /* Make nameListMonad be the builder fn for instance Monad [].
 611               Standalone hugs does this with a disgusting hack in
 612               checkInstDefn() in static.c.  We have a slightly different
 613               disgusting hack for the combined case.
 614            */
 615            {
 616            Class cm;   /* :: Class   */
 617            List  is;   /* :: [Inst]  */
 618            cm = findClassInAnyModule(findText("Monad"));
 619            assert(nonNull(cm));
 620            is = cclass(cm).instances;
 621            assert(nonNull(is));
 622            while (nonNull(is) && snd(inst(hd(is)).head) != typeList)
 623               is = tl(is);
 624            assert(nonNull(is));
 625            nameListMonad = inst(hd(is)).builder;
 626            assert(nonNull(nameListMonad));
 627            }
 628
 629            break;
 630         }
 631         case PREPREL :
 632
 633            if (combined) {
 634                Module modulePrelBase;
 635
 636                modulePrelude = findFakeModule(textPrelude);
 637
 638                nameMkC = addWiredInBoxingTycon("PrelBase", "Char",  "C#",
 639                                                CHAR_REP,   STAR );
 640                nameMkI = addWiredInBoxingTycon("PrelBase", "Int",   "I#",
 641                                                INT_REP,    STAR );
 642                nameMkW = addWiredInBoxingTycon("PrelAddr", "Word",  "W#",
 643                                                WORD_REP,   STAR );
 644                nameMkA = addWiredInBoxingTycon("PrelAddr", "Addr",  "A#",
 645                                                ADDR_REP,   STAR );
 646                nameMkF = addWiredInBoxingTycon("PrelFloat","Float", "F#",
 647                                                FLOAT_REP,  STAR );
 648                nameMkD = addWiredInBoxingTycon("PrelFloat","Double","D#",
 649                                                DOUBLE_REP, STAR );
 650                nameMkInteger
 651                        = addWiredInBoxingTycon("PrelNum","Integer","Integer#",
 652                                                0 ,STAR );
 653                nameMkPrimByteArray
 654                        = addWiredInBoxingTycon("PrelGHC","ByteArray",
 655                                                "PrimByteArray#",0 ,STAR );
 656
 657                for (i=0; i<NUM_TUPLES; ++i) {
 658                    if (i != 1) addTupleTycon(i);
 659                }
 660                addWiredInEnumTycon("PrelBase","Bool",
 661                                    doubleton(findText("False"),
 662                                              findText("True")));
 663
 664                //nameMkThreadId
 665                //   = addWiredInBoxingTycon("PrelConc","ThreadId","ThreadId#"
 666                //                           ,1,0,THREADID_REP);
 667
 668                setCurrModule(modulePrelude);
 669
 670                typeArrow = addPrimTycon(findText("(->)"),
 671                                         pair(STAR,pair(STAR,STAR)),
 672                                         2,DATATYPE,NIL);
 673
 674                /* desugaring                            */
 675                pFun(nameInd,            "_indirect");
 676                name(nameInd).number = DFUNNAME;
 677
 678                /* newtype and USE_NEWTYPE_FOR_DICTS     */
 679                /* make a name entry for PrelBase.id _before_ loading Prelude
 680                   since ifSetClassDefaultsAndDCon() may need to refer to
 681                   nameId.
 682                */
 683                modulePrelBase = findModule(findText("PrelBase"));
 684                module(modulePrelBase).objectExtraNames
 685                   = singleton(findText("libHS_cbits"));
 686
 687                setCurrModule(modulePrelBase);
 688                pFun(nameId,             "id");
 689                setCurrModule(modulePrelude);
 690
 691            } else {
 692                fixupRTStoPreludeRefs(NULL);
 693
 694                modulePrelude = //newModule(textPrelude);
 695                                findFakeModule(textPrelude);
 696                setCurrModule(modulePrelude);
 697
 698                for (i=0; i<NUM_TUPLES; ++i) {
 699                    if (i != 1) addTupleTycon(i);
 700                }
 701                setCurrModule(modulePrelude);
 702
 703                typeArrow = addPrimTycon(findText("(->)"),
 704                                         pair(STAR,pair(STAR,STAR)),
 705                                         2,DATATYPE,NIL);
 706
 707                /* newtype and USE_NEWTYPE_FOR_DICTS     */
 708                pFun(nameId,             "id");
 709
 710                /* desugaring                            */
 711                pFun(nameInd,            "_indirect");
 712                name(nameInd).number = DFUNNAME;
 713
 714                /* pmc                                   */
 715                pFun(nameSel,            "_SEL");
 716
 717                /* strict constructors                   */
 718                pFun(nameFlip,           "flip"     );
 719
 720                /* parser                                */
 721                pFun(nameFromTo,         "enumFromTo");
 722                pFun(nameFromThenTo,     "enumFromThenTo");
 723                pFun(nameFrom,           "enumFrom");
 724                pFun(nameFromThen,       "enumFromThen");
 725
 726                /* deriving                              */
 727                pFun(nameApp,            "++");
 728                pFun(nameReadField,      "hugsprimReadField");
 729                pFun(nameReadParen,      "readParen");
 730                pFun(nameShowField,      "hugsprimShowField");
 731                pFun(nameShowParen,      "showParen");
 732                pFun(nameLex,            "lex");
 733                pFun(nameComp,           ".");
 734                pFun(nameAnd,            "&&");
 735                pFun(nameCompAux,        "hugsprimCompAux");
 736                pFun(nameMap,            "map");
 737
 738                /* implementTagToCon                     */
 739                pFun(namePMFail,         "hugsprimPmFail");
 740                pFun(nameError,          "error");
 741                pFun(nameUnpackString,   "hugsprimUnpackString");
 742
 743                /* assertion and exception issues */
 744                pFun(nameAssert,         "assert");
 745                pFun(nameAssertError,    "assertError");
 746                pFun(nameTangleMessage,  "tangleMessager");
 747                pFun(nameIrrefutPatError,
 748                                         "irrefutPatError");
 749                pFun(nameNoMethodBindingError,
 750                                         "noMethodBindingError");
 751                pFun(nameNonExhaustiveGuardsError,
 752                                         "nonExhaustiveGuardsError");
 753                pFun(namePatError,       "patError");
 754                pFun(nameRecSelError,    "recSelError");
 755                pFun(nameRecConError,    "recConError");
 756                pFun(nameRecUpdError,    "recUpdError");
 757
 758                /* hooks for handwritten bytecode */
 759                pFun(namePrimSeq,        "primSeq");
 760                pFun(namePrimCatch,      "primCatch");
 761                pFun(namePrimRaise,      "primRaise");
 762                pFun(namePrimTakeMVar,   "primTakeMVar");
 763                {
 764                   StgVar vv = mkStgVar(NIL,NIL);
 765                   Name n = namePrimSeq;
 766                   name(n).line = 0;
 767                   name(n).arity = 1;
 768                   name(n).type = NIL;
 769                   vv = mkStgVar(NIL,NIL);
 770                   stgVarInfo(vv) = mkPtr ( asm_BCO_seq() );
 771                   name(n).stgVar = vv;
 772                   stgGlobals=cons(pair(n,vv),stgGlobals);
 773                   namePrimSeq = n;
 774                }
 775                {
 776                   StgVar vv = mkStgVar(NIL,NIL);
 777                   Name n = namePrimCatch;
 778                   name(n).line = 0;
 779                   name(n).arity = 2;
 780                   name(n).type = NIL;
 781                   stgVarInfo(vv) = mkPtr ( asm_BCO_catch() );
 782                   name(n).stgVar = vv;
 783                   stgGlobals=cons(pair(n,vv),stgGlobals);
 784                }
 785                {
 786                   StgVar vv = mkStgVar(NIL,NIL);
 787                   Name n = namePrimRaise;
 788                   name(n).line = 0;
 789                   name(n).arity = 1;
 790                   name(n).type = NIL;
 791                   stgVarInfo(vv) = mkPtr ( asm_BCO_raise() );
 792                   name(n).stgVar = vv;
 793                   stgGlobals=cons(pair(n,vv),stgGlobals);
 794                }
 795                {
 796                   StgVar vv = mkStgVar(NIL,NIL);
 797                   Name n = namePrimTakeMVar;
 798                   name(n).line = 0;
 799                   name(n).arity = 2;
 800                   name(n).type = NIL;
 801                   stgVarInfo(vv) = mkPtr ( asm_BCO_takeMVar() );
 802                   name(n).stgVar = vv;
 803                   stgGlobals=cons(pair(n,vv),stgGlobals);
 804                }
 805            }
 806            break;
 807     }
 808 }
 809 #undef pFun
 810
 811 //#include "fooble.c"
 812 /*-------------------------------------------------------------------------*/