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