ghc/interpreter/link.c

   1
   2 /* --------------------------------------------------------------------------
   3  * Load symbols required from the Prelude
   4  *
   5  * Copyright (c) The University of Nottingham and Yale University, 1994-1997.
   6  * All rights reserved. See NOTICE for details and conditions of use etc...
   7  * Hugs version 1.4, December 1997
   8  *
   9  * $RCSfile: link.c,v $
  10  * $Revision: 1.6 $
  11  * $Date: 1999/03/09 14:51:08 $
  12  * ------------------------------------------------------------------------*/
  13
  14 #include "prelude.h"
  15 #include "storage.h"
  16 #include "backend.h"
  17 #include "connect.h"
  18 #include "errors.h"
  19 #include "Assembler.h" /* for asmPrimOps and AsmReps */
  20
  21 #include "link.h"
  22
  23 ////Module modulePreludeHugs;
  24
  25
  26 Type typeArrow  =BOGUS(1);                         /* Function spaces                 */
  27
  28 Type typeChar  =BOGUS(2);
  29 Type typeInt  =BOGUS(3);
  30 #ifdef PROVIDE_INT64
  31 Type typeInt64  =BOGUS(4);
  32 #endif
  33 #ifdef PROVIDE_INTEGER
  34 Type typeInteger  =BOGUS(5);
  35 #endif
  36 #ifdef PROVIDE_WORD
  37 Type typeWord  =BOGUS(6);
  38 #endif
  39 #ifdef PROVIDE_ADDR
  40 Type typeAddr  =BOGUS(7);
  41 #endif
  42 #ifdef PROVIDE_ARRAY
  43 Type typePrimArray  =BOGUS(8);
  44 Type typePrimByteArray  =BOGUS(9);
  45 Type typeRef  =BOGUS(10);
  46 Type typePrimMutableArray  =BOGUS(11);
  47 Type typePrimMutableByteArray  =BOGUS(12);
  48 #endif
  49 Type typeFloat  =BOGUS(13);
  50 Type typeDouble  =BOGUS(14);
  51 #ifdef PROVIDE_STABLE
  52 Type typeStable  =BOGUS(15);
  53 #endif
  54 #ifdef PROVIDE_WEAK
  55 Type typeWeak  =BOGUS(16);
  56 #endif
  57 #ifdef PROVIDE_FOREIGN
  58 Type typeForeign  =BOGUS(17);
  59 #endif
  60 #ifdef PROVIDE_CONCURRENT
  61 Type typeThreadId  =BOGUS(18);
  62 Type typeMVar  =BOGUS(19);
  63 #endif
  64
  65 Type typeList  =BOGUS(20);
  66 Type typeUnit  =BOGUS(21);
  67 Type typeString  =BOGUS(22);
  68 Type typeBool  =BOGUS(23);
  69 Type typeST  =BOGUS(24);
  70 Type typeIO  =BOGUS(25);
  71 Type typeException  =BOGUS(26);
  72
  73 Class classEq  =BOGUS(27);                          /* `standard' classes              */
  74 Class classOrd  =BOGUS(28);
  75 Class classShow  =BOGUS(29);
  76 Class classRead  =BOGUS(30);
  77 Class classIx  =BOGUS(31);
  78 Class classEnum  =BOGUS(32);
  79 Class classBounded  =BOGUS(33);
  80 #if EVAL_INSTANCES
  81 Class classEval  =BOGUS(34);
  82 #endif
  83
  84 Class classReal  =BOGUS(35);                        /* `numeric' classes               */
  85 Class classIntegral  =BOGUS(36);
  86 Class classRealFrac  =BOGUS(37);
  87 Class classRealFloat  =BOGUS(38);
  88 Class classFractional  =BOGUS(39);
  89 Class classFloating  =BOGUS(40);
  90 Class classNum  =BOGUS(41);
  91
  92 Class classMonad  =BOGUS(42);                       /* Monads and monads with a zero   */
  93 /*Class classMonad0  =BOGUS();*/
  94
  95 List stdDefaults  =BOGUS(43);                       /* standard default values         */
  96
  97 Name nameTrue  =BOGUS(44),
  98      nameFalse  =BOGUS(45);            /* primitive boolean constructors  */
  99 Name nameNil  =BOGUS(46),
 100      nameCons  =BOGUS(47);             /* primitive list constructors     */
 101 Name nameUnit  =BOGUS(48);                          /* primitive Unit type constructor */
 102
 103 Name nameEq  =BOGUS(49);
 104 Name nameFromInt  =BOGUS(50),
 105      nameFromDouble  =BOGUS(51);       /* coercion of numerics            */
 106 Name nameFromInteger  =BOGUS(52);
 107 Name nameReturn  =BOGUS(53),
 108      nameBind  =BOGUS(54);             /* for translating monad comps     */
 109 Name nameZero  =BOGUS(55);                          /* for monads with a zero          */
 110 #if EVAL_INSTANCES
 111 Name nameStrict  =BOGUS(56);                        /* Members of class Eval           */
 112 Name nameSeq  =BOGUS(57);
 113 #endif
 114
 115 Name nameId  =BOGUS(58);
 116 Name nameRunIO  =BOGUS(59);
 117 Name namePrint  =BOGUS(60);
 118
 119 Name nameOtherwise  =BOGUS(61);
 120 Name nameUndefined  =BOGUS(62);                     /* generic undefined value         */
 121 #if NPLUSK
 122 Name namePmSub  =BOGUS(63);
 123 #endif
 124 Name namePMFail  =BOGUS(64);
 125 Name namePMFailBUG = BOGUS(666);
 126 Name nameEqChar  =BOGUS(65);
 127 Name nameEqInt  =BOGUS(66);
 128 #if !OVERLOADED_CONSTANTS
 129 Name nameEqInteger  =BOGUS(67);
 130 #endif
 131 Name nameEqDouble  =BOGUS(68);
 132 Name namePmInt  =BOGUS(69);
 133 Name namePmInteger  =BOGUS(70);
 134 Name namePmDouble  =BOGUS(71);
 135 Name namePmLe  =BOGUS(72);
 136 Name namePmSubtract  =BOGUS(73);
 137 Name namePmFromInteger  =BOGUS(74);
 138 Name nameMkIO  =BOGUS(75);
 139 Name nameUnpackString  =BOGUS(76);
 140 Name nameError  =BOGUS(77);
 141 Name nameInd  =BOGUS(78);
 142
 143 Name nameAnd  =BOGUS(80);
 144 Name nameConCmp  =BOGUS(82);
 145 Name nameCompAux  =BOGUS(83);
 146 Name nameEnFrTh  =BOGUS(84);
 147 Name nameEnFrTo  =BOGUS(85);
 148 Name nameEnFrom  =BOGUS(86);
 149 Name nameEnFrEn  =BOGUS(87);
 150 Name nameEnToEn  =BOGUS(88);
 151 Name nameEnInRng  =BOGUS(89);
 152 Name nameEnIndex  =BOGUS(90);
 153 Name nameEnRange  =BOGUS(91);
 154 Name nameRangeSize  =BOGUS(92);
 155 Name nameComp  =BOGUS(93);
 156 Name nameShowField  =BOGUS(94);
 157 Name nameApp  =BOGUS(95);
 158 Name nameShowParen  =BOGUS(96);
 159 Name nameReadParen  =BOGUS(97);
 160 Name nameLex  =BOGUS(98);
 161 Name nameReadField  =BOGUS(99);
 162 Name nameFlip  =BOGUS(100);
 163
 164 Name namePrimSeq =BOGUS(1000);
 165 Name namePrimCatch =BOGUS(1001);
 166 Name namePrimRaise =BOGUS(1002);
 167
 168 Name nameFromTo  =BOGUS(101);
 169 Name nameFromThen  =BOGUS(102);
 170 Name nameFrom  =BOGUS(103);
 171 Name nameFromThenTo  =BOGUS(104);
 172 Name nameNegate  =BOGUS(105);
 173
 174 /* these names are required before we've had a chance to do the right thing */
 175 Name nameSel  =BOGUS(106);
 176 Name nameUnsafeUnpackCString  =BOGUS(107);
 177
 178 /* constructors used during translation and codegen */
 179 Name nameMkC  =BOGUS(108);                           /* Char#        -> Char           */
 180 Name nameMkI  =BOGUS(109);                           /* Int#         -> Int            */
 181 #ifdef PROVIDE_INT64
 182 Name nameMkInt64  =BOGUS(110);                       /* Int64#       -> Int64          */
 183 #endif
 184 #ifdef PROVIDE_INTEGER
 185 Name nameMkInteger  =BOGUS(111);                     /* Integer#     -> Integer        */
 186 #endif
 187 #ifdef PROVIDE_WORD
 188 Name nameMkW  =BOGUS(112);                           /* Word#        -> Word           */
 189 #endif
 190 #ifdef PROVIDE_ADDR
 191 Name nameMkA  =BOGUS(113);                           /* Addr#        -> Addr            */
 192 #endif
 193 Name nameMkF  =BOGUS(114);                           /* Float#       -> Float           */
 194 Name nameMkD  =BOGUS(115);                           /* Double#      -> Double          */
 195 #ifdef PROVIDE_ARRAY
 196 Name nameMkPrimArray  =BOGUS(116);
 197 Name nameMkPrimByteArray  =BOGUS(117);
 198 Name nameMkRef  =BOGUS(118);
 199 Name nameMkPrimMutableArray  =BOGUS(119);
 200 Name nameMkPrimMutableByteArray  =BOGUS(120);
 201 #endif
 202 #ifdef PROVIDE_STABLE
 203 Name nameMkStable  =BOGUS(121);                      /* StablePtr# a -> StablePtr a     */
 204 #endif
 205 #ifdef PROVIDE_WEAK
 206 Name nameMkWeak  =BOGUS(122);                        /* Weak# a      -> Weak a          */
 207 #endif
 208 #ifdef PROVIDE_FOREIGN
 209 Name nameMkForeign  =BOGUS(123);                     /* ForeignObj#  -> ForeignObj      */
 210 #endif
 211 #ifdef PROVIDE_CONCURRENT
 212 Name nameMkThreadId  =BOGUS(124);                    /* ThreadId#    -> ThreadId        */
 213 Name nameMkMVar  =BOGUS(125);                        /* MVar#        -> MVar            */
 214 #endif
 215
 216
 217
 218 Name nameMinBnd =BOGUS(400);
 219 Name  nameMaxBnd =BOGUS(401);
 220 Name  nameCompare =BOGUS(402);
 221 Name nameShowsPrec =BOGUS(403);
 222 Name  nameIndex =BOGUS(404);
 223 Name nameReadsPrec =BOGUS(405);
 224 Name nameRange =BOGUS(406);
 225 Name nameEQ =BOGUS(407);
 226 Name nameInRange =BOGUS(408);
 227 Name nameGt =BOGUS(409);
 228 Name nameLe =BOGUS(410);
 229 Name namePlus =BOGUS(411);
 230 Name nameMult =BOGUS(412);
 231 Name nameMFail =BOGUS(413);
 232 Type typeOrdering =BOGUS(414);
 233 Module modulePrelude =BOGUS(415);
 234 Name nameMap  = BOGUS(416);
 235 Name nameMinus = BOGUS(417);
 236
 237 #define QQ(lval) assert(lval != 0); assert(lval <= -900000); lval
 238
 239 /* --------------------------------------------------------------------------
 240  * Frequently used type skeletons:
 241  * ------------------------------------------------------------------------*/
 242
 243 /* ToDo: move these to link.c and call them 'typeXXXX' */
 244        Type  arrow=BOGUS(500);                     /* mkOffset(0) -> mkOffset(1)      */
 245        Type  boundPair=BOGUS(500);;                 /* (mkOffset(0),mkOffset(0))       */
 246        Type  listof=BOGUS(500);;                    /* [ mkOffset(0) ]                 */
 247        Type  typeVarToVar=BOGUS(500);;              /* mkOffset(0) -> mkOffset(0)      */
 248
 249        Cell  predNum=BOGUS(500);;                   /* Num (mkOffset(0))               */
 250        Cell  predFractional=BOGUS(500);;            /* Fractional (mkOffset(0))        */
 251        Cell  predIntegral=BOGUS(500);;              /* Integral (mkOffset(0))          */
 252        Kind  starToStar=BOGUS(500);;                /* Type -> Type                    */
 253        Cell  predMonad=BOGUS(500);;                 /* Monad (mkOffset(0))             */
 254
 255 /* --------------------------------------------------------------------------
 256  *
 257  * ------------------------------------------------------------------------*/
 258
 259 static Tycon linkTycon ( String s );
 260 static Tycon linkClass ( String s );
 261 static Name  linkName  ( String s );
 262 static Void  mkTypes   ( void );
 263 static Name  predefinePrim ( String s );
 264
 265
 266 static Tycon linkTycon( String s )
 267 {
 268     Tycon tc = findTycon(findText(s));
 269     if (nonNull(tc)) {
 270         return tc;
 271     }
 272     ERRMSG(0) "Prelude does not define standard type \"%s\"", s
 273     EEND;
 274 }
 275
 276 static Class linkClass( String s )
 277 {
 278     Class cc = findClass(findText(s));
 279     if (nonNull(cc)) {
 280         return cc;
 281     }
 282     ERRMSG(0) "Prelude does not define standard class \"%s\"", s
 283     EEND;
 284 }
 285
 286 static Name linkName( String s )
 287 {
 288     Name n = findName(findText(s));
 289     if (nonNull(n)) {
 290         return n;
 291     }
 292     ERRMSG(0) "Prelude does not define standard name \"%s\"", s
 293     EEND;
 294 }
 295
 296 static Name predefinePrim ( String s )
 297 {
 298     Name nm;
 299     Text t = findText(s);
 300     nm = findName(t);
 301     if (nonNull(nm)) {
 302        //fprintf(stderr, "predefinePrim: %s already exists\n", s );
 303     } else {
 304        nm = newName(t,NIL);
 305        name(nm).defn=PREDEFINED;
 306     }
 307     return nm;
 308 }
 309
 310 Void linkPreludeTC(void) {              /* Hook to tycons and classes in   */
 311     static Bool initialised = FALSE;    /* prelude when first loaded       */
 312     if (!initialised) {
 313         Int i;
 314         initialised = TRUE;
 315         setCurrModule(modulePrelude);
 316
 317         QQ(typeChar      )  = linkTycon("Char");
 318         QQ(typeInt       )  = linkTycon("Int");
 319 #ifdef PROVIDE_INT64
 320         QQ(typeInt64     )  = linkTycon("Int64");
 321 #endif
 322 #ifdef PROVIDE_INTEGER
 323         QQ(typeInteger   )  = linkTycon("Integer");
 324 #endif
 325 #ifdef PROVIDE_WORD
 326         QQ(typeWord      )  = linkTycon("Word");
 327 #endif
 328 #ifdef PROVIDE_ADDR
 329         QQ(typeAddr      )  = linkTycon("Addr");
 330 #endif
 331 #ifdef PROVIDE_ARRAY
 332         QQ(typePrimArray )           = linkTycon("PrimArray");
 333         QQ(typePrimByteArray)        = linkTycon("PrimByteArray");
 334         QQ(typeRef       )           = linkTycon("Ref");
 335         QQ(typePrimMutableArray)     = linkTycon("PrimMutableArray");
 336         QQ(typePrimMutableByteArray) = linkTycon("PrimMutableByteArray");
 337 #endif
 338         QQ(typeFloat     )  = linkTycon("Float");
 339         QQ(typeDouble    )  = linkTycon("Double");
 340 #ifdef PROVIDE_STABLE
 341         QQ(typeStable    )  = linkTycon("StablePtr");
 342 #endif
 343 #ifdef PROVIDE_WEAK
 344         QQ(typeWeak      )  = linkTycon("Weak");
 345 #endif
 346 #ifdef PROVIDE_FOREIGN
 347         QQ(typeForeign   )  = linkTycon("ForeignObj");
 348 #endif
 349 #ifdef PROVIDE_CONCURRENT
 350         QQ(typeThreadId  )  = linkTycon("ThreadId");
 351         QQ(typeMVar      )  = linkTycon("MVar");
 352 #endif
 353
 354         QQ(typeBool      )  = linkTycon("Bool");
 355         QQ(typeST        )  = linkTycon("ST");
 356         QQ(typeIO        )  = linkTycon("IO");
 357         QQ(typeException )  = linkTycon("Exception");
 358         //qqfail QQ(typeList      )  = linkTycon("[]");
 359         //qqfail QQ(typeUnit      )  = linkTycon("()");
 360         QQ(typeString    )  = linkTycon("String");
 361         QQ(typeOrdering  )  = linkTycon("Ordering");
 362
 363         QQ(classEq       )  = linkClass("Eq");
 364         QQ(classOrd      )  = linkClass("Ord");
 365         QQ(classIx       )  = linkClass("Ix");
 366         QQ(classEnum     )  = linkClass("Enum");
 367         QQ(classShow     )  = linkClass("Show");
 368         QQ(classRead     )  = linkClass("Read");
 369         QQ(classBounded  )  = linkClass("Bounded");
 370 #if EVAL_INSTANCES
 371         classEval       = linkClass("Eval");
 372 #endif
 373         QQ(classReal     )  = linkClass("Real");
 374         QQ(classIntegral )  = linkClass("Integral");
 375         QQ(classRealFrac )  = linkClass("RealFrac");
 376         QQ(classRealFloat)  = linkClass("RealFloat");
 377         QQ(classFractional) = linkClass("Fractional");
 378         QQ(classFloating )  = linkClass("Floating");
 379         QQ(classNum      )  = linkClass("Num");
 380         QQ(classMonad    )  = linkClass("Monad");
 381
 382         stdDefaults     = NIL;
 383         stdDefaults     = cons(typeDouble,stdDefaults);
 384 #if DEFAULT_BIGNUM
 385         stdDefaults     = cons(typeBignum,stdDefaults);
 386 #else
 387         stdDefaults     = cons(typeInt,stdDefaults);
 388 #endif
 389         mkTypes();
 390
 391         QQ(nameMkC       )  = addPrimCfunREP(findText("C#"),1,0,CHAR_REP);
 392         QQ(nameMkI       )  = addPrimCfunREP(findText("I#"),1,0,INT_REP);
 393 #ifdef PROVIDE_INT64
 394         QQ(nameMkInt64   )  = addPrimCfunREP(findText("Int64#"),1,0,INT64_REP);
 395 #endif
 396 #ifdef PROVIDE_WORD
 397         QQ(nameMkW       )  = addPrimCfunREP(findText("W#"),1,0,WORD_REP);
 398 #endif
 399 #ifdef PROVIDE_ADDR
 400         QQ(nameMkA       )  = addPrimCfunREP(findText("A#"),1,0,ADDR_REP);
 401 #endif
 402         QQ(nameMkF       )  = addPrimCfunREP(findText("F#"),1,0,FLOAT_REP);
 403         QQ(nameMkD       )  = addPrimCfunREP(findText("D#"),1,0,DOUBLE_REP);
 404 #ifdef PROVIDE_STABLE
 405         QQ(nameMkStable  )  = addPrimCfunREP(findText("Stable#"),1,0,STABLE_REP);
 406 #endif
 407
 408 #ifdef PROVIDE_INTEGER
 409         QQ(nameMkInteger )  = addPrimCfunREP(findText("Integer#"),1,0,0);
 410 #endif
 411 #ifdef PROVIDE_FOREIGN
 412         QQ(nameMkForeign )  = addPrimCfunREP(findText("Foreign#"),1,0,0);
 413 #endif
 414 #ifdef PROVIDE_WEAK
 415         QQ(nameMkWeak    )  = addPrimCfunREP(findText("Weak#"),1,0,0);
 416 #endif
 417 #ifdef PROVIDE_ARRAY
 418         QQ(nameMkPrimArray           ) = addPrimCfunREP(findText("PrimArray#"),1,0,0);
 419         QQ(nameMkPrimByteArray       ) = addPrimCfunREP(findText("PrimByteArray#"),1,0,0);
 420         QQ(nameMkRef                 ) = addPrimCfunREP(findText("Ref#"),1,0,0);
 421         QQ(nameMkPrimMutableArray    ) = addPrimCfunREP(findText("PrimMutableArray#"),1,0,0);
 422         QQ(nameMkPrimMutableByteArray) = addPrimCfunREP(findText("PrimMutableByteArray#"),1,0,0);
 423 #endif
 424 #ifdef PROVIDE_CONCURRENT
 425         QQ(nameMkThreadId)  = addPrimCfun(findTextREP("ThreadId#"),1,0,0);
 426         QQ(nameMkMVar    )  = addPrimCfun(findTextREP("MVar#"),1,0,0);
 427 #endif
 428         /* The following primitives are referred to in derived instances and
 429          * hence require types; the following types are a little more general
 430          * than we might like, but they are the closest we can get without a
 431          * special datatype class.
 432          */
 433         name(nameConCmp).type
 434             = mkPolyType(starToStar,fn(aVar,fn(aVar,typeOrdering)));
 435         name(nameEnRange).type
 436             = mkPolyType(starToStar,fn(boundPair,listof));
 437         name(nameEnIndex).type
 438             = mkPolyType(starToStar,fn(boundPair,fn(aVar,typeInt)));
 439         name(nameEnInRng).type
 440             = mkPolyType(starToStar,fn(boundPair,fn(aVar,typeBool)));
 441         name(nameEnToEn).type
 442             = mkPolyType(starToStar,fn(aVar,fn(typeInt,aVar)));
 443         name(nameEnFrEn).type
 444             = mkPolyType(starToStar,fn(aVar,typeInt));
 445         name(nameEnFrom).type
 446             = mkPolyType(starToStar,fn(aVar,listof));
 447         name(nameEnFrTo).type
 448             = name(nameEnFrTh).type
 449             = mkPolyType(starToStar,fn(aVar,fn(aVar,listof)));
 450
 451         name(namePrimSeq).type
 452             = primType(MONAD_Id, "ab", "b");
 453         name(namePrimCatch).type
 454             = primType(MONAD_Id, "aH", "a");
 455         name(namePrimRaise).type
 456             = primType(MONAD_Id, "E", "a");
 457 #if EVAL_INSTANCES
 458         addEvalInst(0,typeArrow,2,NIL); /* Add Eval instances for (->)     */
 459 #endif
 460
 461         for (i=2; i<=NUM_DTUPLES; i++) {/* Add derived instances of tuples */
 462 #if EVAL_INSTANCES
 463             addEvalInst(0,mkTuple(i),i,NIL);
 464 #endif
 465 #if DERIVE_EQ
 466             addTupInst(classEq,i);
 467 #endif
 468 #if DERIVE_ORD
 469             addTupInst(classOrd,i);
 470 #endif
 471 #if DERIVE_IX
 472             addTupInst(classIx,i);
 473 #endif
 474 #if DERIVE_SHOW
 475             addTupInst(classShow,i);
 476 #endif
 477 #if DERIVE_READ
 478             addTupInst(classRead,i);
 479 #endif
 480 #if DERIVE_BOUNDED
 481             addTupInst(classBounded,i);
 482 #endif
 483         }
 484     }
 485 }
 486
 487 static Void mkTypes ( void )
 488 {
 489         //qqfail QQ(arrow         ) = fn(aVar,mkOffset(1));
 490         //qqfail QQ(listof        ) = ap(typeList,aVar);
 491         QQ(predNum       ) = ap(classNum,aVar);
 492         QQ(predFractional) = ap(classFractional,aVar);
 493         QQ(predIntegral  ) = ap(classIntegral,aVar);
 494         QQ(predMonad     ) = ap(classMonad,aVar);
 495 }
 496
 497 Void linkPreludeCM(void) {              /* Hook to cfuns and mfuns in      */
 498     static Bool initialised = FALSE;    /* prelude when first loaded       */
 499     if (!initialised) {
 500         Int i;
 501         initialised = TRUE;
 502         ////setCurrModule(modulePreludeHugs);
 503         setCurrModule(modulePrelude);
 504         /* constructors */
 505         QQ(nameFalse     )  = linkName("False");
 506         QQ(nameTrue      )  = linkName("True");
 507         //qqfail QQ(nameNil       )  = linkName("[]");
 508         //qqfail QQ(nameCons      )  = linkName(":");
 509         //qqfail QQ(nameUnit      )  = linkName("()");
 510         /* members */
 511         QQ(nameEq        )  = linkName("==");
 512         QQ(nameFromInt   )  = linkName("fromInt");
 513         QQ(nameFromInteger) = linkName("fromInteger");
 514         QQ(nameFromDouble)  = linkName("fromDouble");
 515 #if EVAL_INSTANCES
 516         nameStrict      = linkName("strict");
 517         nameSeq         = linkName("seq");
 518 #endif
 519         QQ(nameReturn    )  = linkName("return");
 520         QQ(nameBind      )  = linkName(">>=");
 521
 522         QQ(nameLe        )  = linkName("<=");
 523         QQ(nameGt        )  = linkName(">");
 524         QQ(nameShowsPrec )  = linkName("showsPrec");
 525         QQ(nameReadsPrec )  = linkName("readsPrec");
 526         QQ(nameEQ        )  = linkName("EQ");
 527         QQ(nameCompare   )  = linkName("compare");
 528         QQ(nameMinBnd    )  = linkName("minBound");
 529         QQ(nameMaxBnd    )  = linkName("maxBound");
 530         QQ(nameRange     )  = linkName("range");
 531         QQ(nameIndex     )  = linkName("index");
 532         QQ(namePlus      )  = linkName("+");
 533         QQ(nameMult      )  = linkName("*");
 534         QQ(nameRangeSize )  = linkName("rangeSize");
 535         QQ(nameInRange   )  = linkName("inRange");
 536         QQ(nameMinus     )  = linkName("-");
 537         /* These come before calls to implementPrim */
 538         for(i=0; i<NUM_TUPLES; ++i) {
 539             implementTuple(i);
 540         }
 541     }
 542 }
 543
 544 Void linkPreludeNames(void) {           /* Hook to names defined in Prelude */
 545     static Bool initialised = FALSE;
 546     if (!initialised) {
 547         Int i;
 548         initialised = TRUE;
 549
 550         setCurrModule(modulePrelude);
 551
 552         /* primops */
 553         QQ(nameMkIO)          = linkName("primMkIO");
 554         for (i=0; asmPrimOps[i].name; ++i) {
 555             Text t = findText(asmPrimOps[i].name);
 556             Name n = findName(t);
 557             if (isNull(n)) {
 558                 n = newName(t,NIL);
 559             }
 560             name(n).line   = 0;
 561             name(n).defn   = NIL;
 562             name(n).type   = primType(asmPrimOps[i].monad,
 563                                       asmPrimOps[i].args,
 564                                       asmPrimOps[i].results);
 565             name(n).arity  = strlen(asmPrimOps[i].args);
 566             name(n).primop = &(asmPrimOps[i]);
 567             implementPrim(n);
 568         }
 569
 570         /* static(tidyInfix)                        */
 571         QQ(nameNegate    )    = linkName("negate");
 572         /* user interface                           */
 573         QQ(nameRunIO     )    = linkName("primRunIO");
 574         QQ(namePrint     )    = linkName("print");
 575         /* typechecker (undefined member functions) */
 576         //qqfail QQ(nameError     )    = linkName("error");
 577         /* desugar                                  */
 578         //qqfail QQ(nameId        )    = linkName("id");
 579         QQ(nameOtherwise )    = linkName("otherwise");
 580         QQ(nameUndefined )    = linkName("undefined");
 581         /* pmc                                      */
 582 #if NPLUSK
 583         namePmSub         = linkName("primPmSub");
 584 #endif
 585         /* translator                               */
 586         ////nameUnpackString  = linkName("primUnpackString");
 587         ////namePMFail        = linkName("primPmFail");
 588         QQ(nameEqChar    )    = linkName("primEqChar");
 589         QQ(nameEqInt     )    = linkName("primEqInt");
 590 #if !OVERLOADED_CONSTANTS
 591         QQ(nameEqInteger )    = linkName("primEqInteger");
 592 #endif /* !OVERLOADED_CONSTANTS */
 593         QQ(nameEqDouble  )    = linkName("primEqDouble");
 594         QQ(namePmInt     )    = linkName("primPmInt");
 595         ////namePmInteger     = linkName("primPmInteger");
 596         ////namePmDouble      = linkName("primPmDouble");
 597         ////namePmLe          = linkName("primPmLe");
 598         ////namePmSubtract    = linkName("primPmSubtract");
 599         ////namePmFromInteger = linkName("primPmFromInteger");
 600         ////QQ(nameMap       )    = linkName("map");
 601     }
 602 }
 603
 604
 605 /* ToDo: fix pFun (or eliminate its use) */
 606 #define pFun(n,s)    QQ(n) = predefinePrim(s)
 607
 608 Void linkControl(what)
 609 Int what; {
 610     switch (what) {
 611         case RESET   :
 612         case MARK    :
 613                        break;
 614
 615         case INSTALL : linkControl(RESET);
 616
 617                        modulePrelude = newModule(textPrelude);
 618                        setCurrModule(modulePrelude);
 619
 620                        typeArrow = addPrimTycon(findText("(->)"),
 621                                                 pair(STAR,pair(STAR,STAR)),
 622                                                 2,DATATYPE,NIL);
 623
 624                        /* newtype and USE_NEWTYPE_FOR_DICTS     */
 625                        pFun(nameId,             "id");
 626
 627                        /* desugaring                            */
 628                        pFun(nameInd,            "_indirect");
 629                        name(nameInd).number = DFUNNAME;
 630
 631                        /* pmc                                   */
 632                        pFun(nameSel,            "_SEL");
 633
 634                        /* strict constructors                   */
 635                        pFun(nameFlip,           "flip"     );
 636
 637                        /* parser                                */
 638                        pFun(nameFromTo,         "enumFromTo");
 639                        pFun(nameFromThenTo,     "enumFromThenTo");
 640                        pFun(nameFrom,           "enumFrom");
 641                        pFun(nameFromThen,       "enumFromThen");
 642
 643                        /* deriving                              */
 644                        pFun(nameApp,            "++");
 645                        pFun(nameReadParen,      "readParen");
 646                        pFun(nameShowParen,      "showParen");
 647                        pFun(nameLex,            "lex");
 648                        pFun(nameEnToEn,         "toEnumPR"); //not sure
 649                        pFun(nameEnFrEn,         "fromEnum"); //not sure
 650                        pFun(nameEnFrom,         "enumFrom"); //not sure
 651                        pFun(nameEnFrTh,         "enumFromThen"); //not sure
 652                        pFun(nameEnFrTo,         "enumFromTo"); //not sure
 653                        pFun(nameEnRange,        "range"); //not sure
 654                        pFun(nameEnIndex,        "index"); //not sure
 655                        pFun(nameEnInRng,        "inRange"); //not sure
 656                        pFun(nameConCmp,         "_concmp"); //very not sure
 657                        pFun(nameComp,           ".");
 658                        pFun(nameAnd,            "&&");
 659                        pFun(nameCompAux,        "primCompAux");
 660                        pFun(nameMap,            "map");
 661
 662                        /* implementTagToCon                     */
 663                        pFun(namePMFail,         "primPmFail");
 664                        pFun(namePMFailBUG,      "primPmFailBUG");
 665                        pFun(nameError,          "error");
 666                        pFun(nameUnpackString,   "primUnpackString");
 667
 668                        /* hooks for handwritten bytecode */
 669                        pFun(namePrimSeq,        "primSeq");
 670                        pFun(namePrimCatch,      "primCatch");
 671                        pFun(namePrimRaise,      "primRaise");
 672                        {
 673                           StgVar vv = mkStgVar(NIL,NIL);
 674                           Name n = namePrimSeq;
 675                           name(n).line = 0;
 676                           name(n).arity = 1;
 677                           name(n).type = NIL;
 678                           vv = mkStgVar(NIL,NIL);
 679                           stgVarInfo(vv) = mkPtr ( asm_BCO_seq() );
 680                           name(n).stgVar = vv;
 681                           stgGlobals=cons(pair(n,vv),stgGlobals);
 682                           namePrimSeq = n;
 683                        }
 684                        {
 685                           StgVar vv = mkStgVar(NIL,NIL);
 686                           Name n = namePrimCatch;
 687                           name(n).line = 0;
 688                           name(n).arity = 2;
 689                           name(n).type = NIL;
 690                           stgVarInfo(vv) = mkPtr ( asm_BCO_catch() );
 691                           name(n).stgVar = vv;
 692                           stgGlobals=cons(pair(n,vv),stgGlobals);
 693                        }
 694                        {
 695                           StgVar vv = mkStgVar(NIL,NIL);
 696                           Name n = namePrimRaise;
 697                           name(n).line = 0;
 698                           name(n).arity = 1;
 699                           name(n).type = NIL;
 700                           stgVarInfo(vv) = mkPtr ( asm_BCO_raise() );
 701                           name(n).stgVar = vv;
 702                           stgGlobals=cons(pair(n,vv),stgGlobals);
 703                        }
 704
 705                        break;
 706     }
 707 }
 708 #undef pFun
 709
 710
 711 /*-------------------------------------------------------------------------*/