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/04/27 10:06:54 $
12 * ------------------------------------------------------------------------*/
19 #include "Assembler.h" /* for asmPrimOps and AsmReps */
24 Type typeArrow; /* Function spaces */
32 Type typePrimByteArray;
34 Type typePrimMutableArray;
35 Type typePrimMutableByteArray;
44 #ifdef PROVIDE_FOREIGN
47 #ifdef PROVIDE_CONCURRENT
60 Class classEq; /* `standard' classes */
68 Class classReal; /* `numeric' classes */
72 Class classFractional;
75 Class classMonad; /* Monads and monads with a zero */
77 List stdDefaults; /* standard default values */
80 Name nameFalse; /* primitive boolean constructors */
82 Name nameCons; /* primitive list constructors */
83 Name nameUnit; /* primitive Unit type constructor */
87 Name nameFromDouble; /* coercion of numerics */
90 Name nameBind; /* for translating monad comps */
91 Name nameZero; /* for monads with a zero */
98 Name nameUndefined; /* generic undefined value */
105 #if !OVERLOADED_CONSTANTS
114 Name namePmFromInteger;
116 Name nameUnpackString;
151 /* these names are required before we've had a chance to do the right thing */
153 Name nameUnsafeUnpackCString;
155 /* constructors used during translation and codegen */
156 Name nameMkC; /* Char# -> Char */
157 Name nameMkI; /* Int# -> Int */
158 Name nameMkInteger; /* Integer# -> Integer */
159 Name nameMkW; /* Word# -> Word */
160 Name nameMkA; /* Addr# -> Addr */
161 Name nameMkF; /* Float# -> Float */
162 Name nameMkD; /* Double# -> Double */
163 Name nameMkPrimArray;
164 Name nameMkPrimByteArray;
166 Name nameMkPrimMutableArray;
167 Name nameMkPrimMutableByteArray;
168 #ifdef PROVIDE_STABLE
169 Name nameMkStable; /* StablePtr# a -> StablePtr a */
172 Name nameMkWeak; /* Weak# a -> Weak a */
174 #ifdef PROVIDE_FOREIGN
175 Name nameMkForeign; /* ForeignObj# -> ForeignObj */
177 #ifdef PROVIDE_CONCURRENT
178 Name nameMkThreadId; /* ThreadId# -> ThreadId */
179 Name nameMkMVar; /* MVar# -> MVar */
199 Module modulePrelude;
204 /* --------------------------------------------------------------------------
205 * Frequently used type skeletons:
206 * ------------------------------------------------------------------------*/
208 Type arrow; /* mkOffset(0) -> mkOffset(1) */
209 Type boundPair; /* (mkOffset(0),mkOffset(0)) */
210 Type listof; /* [ mkOffset(0) ] */
211 Type typeVarToVar; /* mkOffset(0) -> mkOffset(0) */
213 Cell predNum; /* Num (mkOffset(0)) */
214 Cell predFractional; /* Fractional (mkOffset(0)) */
215 Cell predIntegral; /* Integral (mkOffset(0)) */
216 Kind starToStar; /* Type -> Type */
217 Cell predMonad; /* Monad (mkOffset(0)) */
219 /* --------------------------------------------------------------------------
221 * ------------------------------------------------------------------------*/
223 static Tycon linkTycon ( String s );
224 static Tycon linkClass ( String s );
225 static Name linkName ( String s );
226 static Void mkTypes ( void );
227 static Name predefinePrim ( String s );
230 static Tycon linkTycon( String s )
232 Tycon tc = findTycon(findText(s));
236 ERRMSG(0) "Prelude does not define standard type \"%s\"", s
240 static Class linkClass( String s )
242 Class cc = findClass(findText(s));
246 ERRMSG(0) "Prelude does not define standard class \"%s\"", s
250 static Name linkName( String s )
252 Name n = findName(findText(s));
256 ERRMSG(0) "Prelude does not define standard name \"%s\"", s
260 static Name predefinePrim ( String s )
263 Text t = findText(s);
266 //fprintf(stderr, "predefinePrim: %s already exists\n", s );
269 name(nm).defn=PREDEFINED;
274 Void linkPreludeTC(void) { /* Hook to tycons and classes in */
275 static Bool initialised = FALSE; /* prelude when first loaded */
279 setCurrModule(modulePrelude);
281 typeChar = linkTycon("Char");
282 typeInt = linkTycon("Int");
283 typeInteger = linkTycon("Integer");
284 typeWord = linkTycon("Word");
285 typeAddr = linkTycon("Addr");
286 typePrimArray = linkTycon("PrimArray");
287 typePrimByteArray = linkTycon("PrimByteArray");
288 typeRef = linkTycon("Ref");
289 typePrimMutableArray = linkTycon("PrimMutableArray");
290 typePrimMutableByteArray = linkTycon("PrimMutableByteArray");
291 typeFloat = linkTycon("Float");
292 typeDouble = linkTycon("Double");
293 #ifdef PROVIDE_STABLE
294 typeStable = linkTycon("StablePtr");
297 typeWeak = linkTycon("Weak");
299 #ifdef PROVIDE_FOREIGN
300 typeForeign = linkTycon("ForeignObj");
302 #ifdef PROVIDE_CONCURRENT
303 typeThreadId = linkTycon("ThreadId");
304 typeMVar = linkTycon("MVar");
307 typeBool = linkTycon("Bool");
308 typeST = linkTycon("ST");
309 typeIO = linkTycon("IO");
310 typeException = linkTycon("Exception");
311 typeString = linkTycon("String");
312 typeOrdering = linkTycon("Ordering");
314 classEq = linkClass("Eq");
315 classOrd = linkClass("Ord");
316 classIx = linkClass("Ix");
317 classEnum = linkClass("Enum");
318 classShow = linkClass("Show");
319 classRead = linkClass("Read");
320 classBounded = linkClass("Bounded");
321 classReal = linkClass("Real");
322 classIntegral = linkClass("Integral");
323 classRealFrac = linkClass("RealFrac");
324 classRealFloat = linkClass("RealFloat");
325 classFractional = linkClass("Fractional");
326 classFloating = linkClass("Floating");
327 classNum = linkClass("Num");
328 classMonad = linkClass("Monad");
331 stdDefaults = cons(typeDouble,stdDefaults);
333 stdDefaults = cons(typeInteger,stdDefaults);
335 stdDefaults = cons(typeInt,stdDefaults);
339 nameMkC = addPrimCfunREP(findText("C#"),1,0,CHAR_REP);
340 nameMkI = addPrimCfunREP(findText("I#"),1,0,INT_REP);
341 nameMkW = addPrimCfunREP(findText("W#"),1,0,WORD_REP);
342 nameMkA = addPrimCfunREP(findText("A#"),1,0,ADDR_REP);
343 nameMkF = addPrimCfunREP(findText("F#"),1,0,FLOAT_REP);
344 nameMkD = addPrimCfunREP(findText("D#"),1,0,DOUBLE_REP);
345 #ifdef PROVIDE_STABLE
346 nameMkStable = addPrimCfunREP(findText("Stable#"),1,0,STABLE_REP);
348 nameMkInteger = addPrimCfunREP(findText("Integer#"),1,0,0);
349 #ifdef PROVIDE_FOREIGN
350 nameMkForeign = addPrimCfunREP(findText("Foreign#"),1,0,0);
353 nameMkWeak = addPrimCfunREP(findText("Weak#"),1,0,0);
355 nameMkPrimArray = addPrimCfunREP(findText("PrimArray#"),1,0,0);
356 nameMkPrimByteArray = addPrimCfunREP(findText("PrimByteArray#"),1,0,0);
357 nameMkRef = addPrimCfunREP(findText("Ref#"),1,0,0);
358 nameMkPrimMutableArray = addPrimCfunREP(findText("PrimMutableArray#"),1,0,0);
359 nameMkPrimMutableByteArray = addPrimCfunREP(findText("PrimMutableByteArray#"),1,0,0);
360 #ifdef PROVIDE_CONCURRENT
361 nameMkThreadId = addPrimCfun(findTextREP("ThreadId#"),1,0,0);
362 nameMkMVar = addPrimCfun(findTextREP("MVar#"),1,0,0);
364 /* The following primitives are referred to in derived instances and
365 * hence require types; the following types are a little more general
366 * than we might like, but they are the closest we can get without a
367 * special datatype class.
369 name(nameConCmp).type
370 = mkPolyType(starToStar,fn(aVar,fn(aVar,typeOrdering)));
371 name(nameEnRange).type
372 = mkPolyType(starToStar,fn(boundPair,listof));
373 name(nameEnIndex).type
374 = mkPolyType(starToStar,fn(boundPair,fn(aVar,typeInt)));
375 name(nameEnInRng).type
376 = mkPolyType(starToStar,fn(boundPair,fn(aVar,typeBool)));
377 name(nameEnToEn).type
378 = mkPolyType(starToStar,fn(aVar,fn(typeInt,aVar)));
379 name(nameEnFrEn).type
380 = mkPolyType(starToStar,fn(aVar,typeInt));
381 name(nameEnFrom).type
382 = mkPolyType(starToStar,fn(aVar,listof));
383 name(nameEnFrTo).type
384 = name(nameEnFrTh).type
385 = mkPolyType(starToStar,fn(aVar,fn(aVar,listof)));
387 name(namePrimSeq).type
388 = primType(MONAD_Id, "ab", "b");
389 name(namePrimCatch).type
390 = primType(MONAD_Id, "aH", "a");
391 name(namePrimRaise).type
392 = primType(MONAD_Id, "E", "a");
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);
405 static Void mkTypes ( void )
407 predNum = ap(classNum,aVar);
408 predFractional = ap(classFractional,aVar);
409 predIntegral = ap(classIntegral,aVar);
410 predMonad = ap(classMonad,aVar);
413 Void linkPreludeCM(void) { /* Hook to cfuns and mfuns in */
414 static Bool initialised = FALSE; /* prelude when first loaded */
419 setCurrModule(modulePrelude);
422 nameFalse = linkName("False");
423 nameTrue = linkName("True");
426 nameEq = linkName("==");
427 nameFromInt = linkName("fromInt");
428 nameFromInteger = linkName("fromInteger");
429 nameFromDouble = linkName("fromDouble");
430 nameReturn = linkName("return");
431 nameBind = linkName(">>=");
432 nameLe = linkName("<=");
433 nameGt = linkName(">");
434 nameShowsPrec = linkName("showsPrec");
435 nameReadsPrec = linkName("readsPrec");
436 nameEQ = linkName("EQ");
437 nameCompare = linkName("compare");
438 nameMinBnd = linkName("minBound");
439 nameMaxBnd = linkName("maxBound");
440 nameRange = linkName("range");
441 nameIndex = linkName("index");
442 namePlus = linkName("+");
443 nameMult = linkName("*");
444 nameRangeSize = linkName("rangeSize");
445 nameInRange = linkName("inRange");
446 nameMinus = linkName("-");
447 /* These come before calls to implementPrim */
448 for(i=0; i<NUM_TUPLES; ++i) {
454 Void linkPreludeNames(void) { /* Hook to names defined in Prelude */
455 static Bool initialised = FALSE;
460 setCurrModule(modulePrelude);
463 nameMkIO = linkName("primMkIO");
464 for (i=0; asmPrimOps[i].name; ++i) {
465 Text t = findText(asmPrimOps[i].name);
466 Name n = findName(t);
472 name(n).type = primType(asmPrimOps[i].monad,
474 asmPrimOps[i].results);
475 name(n).arity = strlen(asmPrimOps[i].args);
476 name(n).primop = &(asmPrimOps[i]);
480 /* static(tidyInfix) */
481 nameNegate = linkName("negate");
483 nameRunIO = linkName("primRunIO");
484 namePrint = linkName("print");
486 nameOtherwise = linkName("otherwise");
487 nameUndefined = linkName("undefined");
490 namePmSub = linkName("primPmSub");
493 nameEqChar = linkName("primEqChar");
494 nameEqInt = linkName("primEqInt");
495 #if !OVERLOADED_CONSTANTS
496 nameEqInteger = linkName("primEqInteger");
497 #endif /* !OVERLOADED_CONSTANTS */
498 nameEqDouble = linkName("primEqDouble");
499 namePmInt = linkName("primPmInt");
500 name(namePmInt).inlineMe = TRUE;
505 /* ToDo: fix pFun (or eliminate its use) */
506 #define pFun(n,s) n = predefinePrim(s)
508 Void linkControl(what)
515 case INSTALL : linkControl(RESET);
517 modulePrelude = newModule(textPrelude);
518 setCurrModule(modulePrelude);
520 typeArrow = addPrimTycon(findText("(->)"),
521 pair(STAR,pair(STAR,STAR)),
524 /* newtype and USE_NEWTYPE_FOR_DICTS */
528 pFun(nameInd, "_indirect");
529 name(nameInd).number = DFUNNAME;
532 pFun(nameSel, "_SEL");
534 /* strict constructors */
535 pFun(nameFlip, "flip" );
538 pFun(nameFromTo, "enumFromTo");
539 pFun(nameFromThenTo, "enumFromThenTo");
540 pFun(nameFrom, "enumFrom");
541 pFun(nameFromThen, "enumFromThen");
545 pFun(nameReadParen, "readParen");
546 pFun(nameShowParen, "showParen");
547 pFun(nameLex, "lex");
548 pFun(nameEnToEn, "toEnumPR"); //not sure
549 pFun(nameEnFrEn, "fromEnum"); //not sure
550 pFun(nameEnFrom, "enumFrom"); //not sure
551 pFun(nameEnFrTh, "enumFromThen"); //not sure
552 pFun(nameEnFrTo, "enumFromTo"); //not sure
553 pFun(nameEnRange, "range"); //not sure
554 pFun(nameEnIndex, "index"); //not sure
555 pFun(nameEnInRng, "inRange"); //not sure
556 pFun(nameConCmp, "_concmp"); //very not sure
559 pFun(nameCompAux, "primCompAux");
560 name(nameCompAux).inlineMe = TRUE;
561 pFun(nameMap, "map");
563 /* implementTagToCon */
564 pFun(namePMFail, "primPmFail");
565 pFun(nameError, "error");
566 pFun(nameUnpackString, "primUnpackString");
568 /* hooks for handwritten bytecode */
569 pFun(namePrimSeq, "primSeq");
570 pFun(namePrimCatch, "primCatch");
571 pFun(namePrimRaise, "primRaise");
573 StgVar vv = mkStgVar(NIL,NIL);
574 Name n = namePrimSeq;
578 vv = mkStgVar(NIL,NIL);
579 stgVarInfo(vv) = mkPtr ( asm_BCO_seq() );
581 stgGlobals=cons(pair(n,vv),stgGlobals);
585 StgVar vv = mkStgVar(NIL,NIL);
586 Name n = namePrimCatch;
590 stgVarInfo(vv) = mkPtr ( asm_BCO_catch() );
592 stgGlobals=cons(pair(n,vv),stgGlobals);
595 StgVar vv = mkStgVar(NIL,NIL);
596 Name n = namePrimRaise;
600 stgVarInfo(vv) = mkPtr ( asm_BCO_raise() );
602 stgGlobals=cons(pair(n,vv),stgGlobals);
611 /*-------------------------------------------------------------------------*/