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