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