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