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