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