2 /* --------------------------------------------------------------------------
3 * Load symbols required from the Prelude
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
11 * $Date: 1999/02/03 17:08:31 $
12 * ------------------------------------------------------------------------*/
19 #include "Assembler.h" /* for asmPrimOps and AsmReps */
23 Module modulePreludeHugs;
25 Type typeArrow; /* Function spaces */
32 #ifdef PROVIDE_INTEGER
43 Type typePrimByteArray;
45 Type typePrimMutableArray;
46 Type typePrimMutableByteArray;
56 #ifdef PROVIDE_FOREIGN
59 #ifdef PROVIDE_CONCURRENT
72 Class classEq; /* `standard' classes */
83 Class classReal; /* `numeric' classes */
87 Class classFractional;
91 Class classMonad; /* Monads and monads with a zero */
92 /*Class classMonad0;*/
94 List stdDefaults; /* standard default values */
96 Name nameTrue, nameFalse; /* primitive boolean constructors */
97 Name nameNil, nameCons; /* primitive list constructors */
98 Name nameUnit; /* primitive Unit type constructor */
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 */
106 Name nameStrict; /* Members of class Eval */
115 Name nameUndefined; /* generic undefined value */
122 #if !OVERLOADED_CONSTANTS
131 Name namePmFromInteger;
133 Name nameUnpackString;
166 /* these names are required before we've had a chance to do the right thing */
168 Name nameUnsafeUnpackCString;
170 /* constructors used during translation and codegen */
171 Name nameMkC; /* Char# -> Char */
172 Name nameMkI; /* Int# -> Int */
174 Name nameMkInt64; /* Int64# -> Int64 */
176 #ifdef PROVIDE_INTEGER
177 Name nameMkInteger; /* Integer# -> Integer */
180 Name nameMkW; /* Word# -> Word */
183 Name nameMkA; /* Addr# -> Addr */
185 Name nameMkF; /* Float# -> Float */
186 Name nameMkD; /* Double# -> Double */
188 Name nameMkPrimArray;
189 Name nameMkPrimByteArray;
191 Name nameMkPrimMutableArray;
192 Name nameMkPrimMutableByteArray;
194 #ifdef PROVIDE_STABLE
195 Name nameMkStable; /* StablePtr# a -> StablePtr a */
198 Name nameMkWeak; /* Weak# a -> Weak a */
200 #ifdef PROVIDE_FOREIGN
201 Name nameMkForeign; /* ForeignObj# -> ForeignObj */
203 #ifdef PROVIDE_CONCURRENT
204 Name nameMkThreadId; /* ThreadId# -> ThreadId */
205 Name nameMkMVar; /* MVar# -> MVar */
208 /* --------------------------------------------------------------------------
210 * ------------------------------------------------------------------------*/
212 static Tycon linkTycon ( String s );
213 static Tycon linkClass ( String s );
214 static Name linkName ( String s );
215 static Void mkTypes ();
218 static Tycon linkTycon( String s )
220 Tycon tc = findTycon(findText(s));
224 ERRMSG(0) "Prelude does not define standard type \"%s\"", s
228 static Class linkClass( String s )
230 Class cc = findClass(findText(s));
234 ERRMSG(0) "Prelude does not define standard class \"%s\"", s
238 static Name linkName( String s )
240 Name n = findName(findText(s));
244 ERRMSG(0) "Prelude does not define standard name \"%s\"", s
248 /* ToDo: kill this! */
249 static Name predefinePrim ( String s );
250 static Name predefinePrim ( String s )
252 Name nm = newName(findText(s),NIL);
253 name(nm).defn=PREDEFINED;
257 Void linkPreludeTC() { /* Hook to tycons and classes in */
258 static Bool initialised = FALSE; /* prelude when first loaded */
262 setCurrModule(modulePreludeHugs);
264 typeChar = linkTycon("Char");
265 typeInt = linkTycon("Int");
267 typeInt64 = linkTycon("Int64");
269 #ifdef PROVIDE_INTEGER
270 typeInteger = linkTycon("Integer");
273 typeWord = linkTycon("Word");
276 typeAddr = linkTycon("Addr");
279 typePrimArray = linkTycon("PrimArray");
280 typePrimByteArray = linkTycon("PrimByteArray");
281 typeRef = linkTycon("Ref");
282 typePrimMutableArray = linkTycon("PrimMutableArray");
283 typePrimMutableByteArray = linkTycon("PrimMutableByteArray");
285 typeFloat = linkTycon("Float");
286 typeDouble = linkTycon("Double");
287 #ifdef PROVIDE_STABLE
288 typeStable = linkTycon("StablePtr");
291 typeWeak = linkTycon("Weak");
293 #ifdef PROVIDE_FOREIGN
294 typeForeign = linkTycon("ForeignObj");
296 #ifdef PROVIDE_CONCURRENT
297 typeThreadId = linkTycon("ThreadId");
298 typeMVar = linkTycon("MVar");
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");
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");
317 classEval = linkClass("Eval");
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");*/
330 stdDefaults = cons(typeDouble,stdDefaults);
332 stdDefaults = cons(typeBignum,stdDefaults);
334 stdDefaults = cons(typeInt,stdDefaults);
338 nameMkC = addPrimCfun(findText("C#"),1,0,CHAR_REP);
339 nameMkI = addPrimCfun(findText("I#"),1,0,INT_REP);
341 nameMkInt64 = addPrimCfun(findText("Int64#"),1,0,INT64_REP);
344 nameMkW = addPrimCfun(findText("W#"),1,0,WORD_REP);
347 nameMkA = addPrimCfun(findText("A#"),1,0,ADDR_REP);
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);
355 #ifdef PROVIDE_INTEGER
356 nameMkInteger = addPrimCfun(findText("Integer#"),1,0,0);
358 #ifdef PROVIDE_FOREIGN
359 nameMkForeign = addPrimCfun(findText("Foreign#"),1,0,0);
362 nameMkWeak = addPrimCfun(findText("Weak#"),1,0,0);
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);
371 #ifdef PROVIDE_CONCURRENT
372 nameMkThreadId = addPrimCfun(findText("ThreadId#"),1,0,0);
373 nameMkMVar = addPrimCfun(findText("MVar#"),1,0,0);
377 addEvalInst(0,typeArrow,2,NIL); /* Add Eval instances for (->) */
380 for (i=2; i<=NUM_DTUPLES; i++) {/* Add derived instances of tuples */
382 addEvalInst(0,mkTuple(i),i,NIL);
385 addTupInst(classEq,i);
388 addTupInst(classOrd,i);
391 addTupInst(classIx,i);
394 addTupInst(classShow,i);
397 addTupInst(classRead,i);
400 addTupInst(classBounded,i);
406 static Void mkTypes()
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);*/
417 Void linkPreludeCM() { /* Hook to cfuns and mfuns in */
418 static Bool initialised = FALSE; /* prelude when first loaded */
422 setCurrModule(modulePreludeHugs);
424 nameFalse = linkName("False");
425 nameTrue = linkName("True");
426 nameNil = linkName("[]");
427 nameCons = linkName(":");
428 nameUnit = linkName("()");
430 nameEq = linkName("==");
431 nameFromInt = linkName("fromInt");
432 nameFromInteger = linkName("fromInteger");
433 nameFromDouble = linkName("fromDouble");
435 nameStrict = linkName("strict");
436 nameSeq = linkName("seq");
438 nameReturn = linkName("return");
439 nameBind = linkName(">>=");
440 nameZero = linkName("zero");
442 /* These come before calls to implementPrim */
443 for(i=0; i<NUM_TUPLES; ++i) {
449 Void linkPreludeNames() { /* Hook to names defined in Prelude */
450 static Bool initialised = FALSE;
454 setCurrModule(modulePreludeHugs);
457 nameMkIO = linkName("primMkIO");
458 for (i=0; asmPrimOps[i].name; ++i) {
459 Text t = findText(asmPrimOps[i].name);
460 Name n = findName(t);
466 name(n).type = primType(asmPrimOps[i].monad,
468 asmPrimOps[i].results);
469 name(n).arity = strlen(asmPrimOps[i].args);
470 name(n).primop = &(asmPrimOps[i]);
475 nameRunIO = linkName("primRunIO");
476 namePrint = linkName("print");
477 /* typechecker (undefined member functions) */
478 nameError = linkName("error");
480 nameId = linkName("id");
481 nameOtherwise = linkName("otherwise");
482 nameUndefined = linkName("undefined");
485 namePmSub = linkName("primPmSub");
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");
505 Void linkControl(what)
514 case INSTALL : linkControl(RESET);
516 modulePreludeHugs = newModule(findText("PreludeBuiltin"));
518 setCurrModule(modulePreludeHugs);
520 typeArrow = addPrimTycon(findText("(->)"),
521 pair(STAR,pair(STAR,STAR)),
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");
529 pFun(nameInd, "_indirect","error");
530 name(nameInd).number = DFUNNAME;
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");
545 /*-------------------------------------------------------------------------*/
549 --## this stuff from 98
552 --## Void linkPreludeTC() { /* Hook to tycons and classes in */
553 --## if (isNull(typeBool)) { /* prelude when first loaded */
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"
571 --## stdDefaults = cons(typeInteger,cons(typeDouble,NIL));
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"));
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) ||
588 --## isNull(classBounded)) {
589 --## ERRMSG(0) "Prelude does not define standard classes"
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"
607 --## predNum = ap(classNum,aVar);
608 --## predFractional = ap(classFractional,aVar);
609 --## predIntegral = ap(classIntegral,aVar);
611 --## classMonad = findClass(findText("Monad"));
612 --## if (isNull(classMonad)) {
613 --## ERRMSG(0) "Prelude does not define Monad class"
616 --## predMonad = ap(classMonad,aVar);
619 --## { Type typeIO = findTycon(findText("IO"));
620 --## if (isNull(typeIO)) {
621 --## ERRMSG(0) "Prelude does not define IO monad constructor"
624 --## typeProgIO = ap(typeIO,aVar);
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.
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)));
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);
656 --## for (i=2; i<=NUM_DTUPLES; i++) {/* Add derived instances of tuples */
657 --## #if EVAL_INSTANCES
658 --## addEvalInst(0,mkTuple(i),i,NIL);
660 --## addTupInst(classEq,i);
661 --## addTupInst(classOrd,i);
662 --## addTupInst(classShow,i);
663 --## addTupInst(classRead,i);
664 --## addTupInst(classIx,i);
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"
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"));
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) ||
723 --## isNull(nameReturn) || isNull(nameBind) ||
724 --## isNull(nameMFail)) {
725 --## ERRMSG(0) "Prelude does not define standard members"