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/10/15 11:02:15 $
12 * ------------------------------------------------------------------------*/
19 #include "Assembler.h" /* for asmPrimOps and AsmReps */
24 Type typeArrow; /* Function spaces */
32 Type typePrimByteArray;
34 Type typePrimMutableArray;
35 Type typePrimMutableByteArray;
42 #ifdef PROVIDE_FOREIGN
45 #ifdef PROVIDE_CONCURRENT
58 Class classEq; /* `standard' classes */
66 Class classReal; /* `numeric' classes */
70 Class classFractional;
73 Class classMonad; /* Monads and monads with a zero */
75 List stdDefaults; /* standard default values */
78 Name nameFalse; /* primitive boolean constructors */
80 Name nameCons; /* primitive list constructors */
81 Name nameUnit; /* primitive Unit type constructor */
85 Name nameFromDouble; /* coercion of numerics */
88 Name nameBind; /* for translating monad comps */
89 Name nameZero; /* for monads with a zero */
96 Name nameUndefined; /* generic undefined value */
103 #if !OVERLOADED_CONSTANTS
112 Name namePmFromInteger;
115 Name nameUnpackString;
118 Name nameCreateAdjThunk;
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 Name nameMkStable; /* StablePtr# a -> StablePtr a */
170 Name nameMkWeak; /* Weak# a -> Weak a */
172 #ifdef PROVIDE_FOREIGN
173 Name nameMkForeign; /* ForeignObj# -> ForeignObj */
175 #ifdef PROVIDE_CONCURRENT
176 Name nameMkThreadId; /* ThreadId# -> ThreadId */
177 Name nameMkMVar; /* MVar# -> MVar */
197 Module modulePrelude;
202 /* --------------------------------------------------------------------------
203 * Frequently used type skeletons:
204 * ------------------------------------------------------------------------*/
206 Type arrow; /* mkOffset(0) -> mkOffset(1) */
207 Type boundPair; /* (mkOffset(0),mkOffset(0)) */
208 Type listof; /* [ mkOffset(0) ] */
209 Type typeVarToVar; /* mkOffset(0) -> mkOffset(0) */
211 Cell predNum; /* Num (mkOffset(0)) */
212 Cell predFractional; /* Fractional (mkOffset(0)) */
213 Cell predIntegral; /* Integral (mkOffset(0)) */
214 Kind starToStar; /* Type -> Type */
215 Cell predMonad; /* Monad (mkOffset(0)) */
217 /* --------------------------------------------------------------------------
219 * ------------------------------------------------------------------------*/
221 static Tycon linkTycon ( String s );
222 static Tycon linkClass ( String s );
223 static Name linkName ( String s );
224 static Void mkTypes ( void );
225 static Name predefinePrim ( String s );
228 static Tycon linkTycon( String s )
230 Tycon tc = findTycon(findText(s));
234 ERRMSG(0) "Prelude does not define standard type \"%s\"", s
238 static Class linkClass( String s )
240 Class cc = findClass(findText(s));
244 ERRMSG(0) "Prelude does not define standard class \"%s\"", s
248 static Name linkName( String s )
250 Name n = findName(findText(s));
254 ERRMSG(0) "Prelude does not define standard name \"%s\"", s
258 static Name predefinePrim ( String s )
261 Text t = findText(s);
264 //fprintf(stderr, "predefinePrim: %s already exists\n", s );
267 name(nm).defn=PREDEFINED;
272 Void linkPreludeTC(void) { /* Hook to tycons and classes in */
273 static Bool initialised = FALSE; /* prelude when first loaded */
277 setCurrModule(modulePrelude);
279 typeChar = linkTycon("Char");
280 typeInt = linkTycon("Int");
281 typeInteger = linkTycon("Integer");
282 typeWord = linkTycon("Word");
283 typeAddr = linkTycon("Addr");
284 typePrimArray = linkTycon("PrimArray");
285 typePrimByteArray = linkTycon("PrimByteArray");
286 typeRef = linkTycon("Ref");
287 typePrimMutableArray = linkTycon("PrimMutableArray");
288 typePrimMutableByteArray = linkTycon("PrimMutableByteArray");
289 typeFloat = linkTycon("Float");
290 typeDouble = linkTycon("Double");
291 typeStable = linkTycon("StablePtr");
293 typeWeak = linkTycon("Weak");
295 #ifdef PROVIDE_FOREIGN
296 typeForeign = linkTycon("ForeignObj");
298 #ifdef PROVIDE_CONCURRENT
299 typeThreadId = linkTycon("ThreadId");
300 typeMVar = linkTycon("MVar");
303 typeBool = linkTycon("Bool");
304 typeST = linkTycon("ST");
305 typeIO = linkTycon("IO");
306 typeException = linkTycon("Exception");
307 typeString = linkTycon("String");
308 typeOrdering = linkTycon("Ordering");
310 classEq = linkClass("Eq");
311 classOrd = linkClass("Ord");
312 classIx = linkClass("Ix");
313 classEnum = linkClass("Enum");
314 classShow = linkClass("Show");
315 classRead = linkClass("Read");
316 classBounded = linkClass("Bounded");
317 classReal = linkClass("Real");
318 classIntegral = linkClass("Integral");
319 classRealFrac = linkClass("RealFrac");
320 classRealFloat = linkClass("RealFloat");
321 classFractional = linkClass("Fractional");
322 classFloating = linkClass("Floating");
323 classNum = linkClass("Num");
324 classMonad = linkClass("Monad");
327 stdDefaults = cons(typeDouble,stdDefaults);
329 stdDefaults = cons(typeInteger,stdDefaults);
331 stdDefaults = cons(typeInt,stdDefaults);
335 nameMkC = addPrimCfunREP(findText("C#"),1,0,CHAR_REP);
336 nameMkI = addPrimCfunREP(findText("I#"),1,0,INT_REP);
337 nameMkW = addPrimCfunREP(findText("W#"),1,0,WORD_REP);
338 nameMkA = addPrimCfunREP(findText("A#"),1,0,ADDR_REP);
339 nameMkF = addPrimCfunREP(findText("F#"),1,0,FLOAT_REP);
340 nameMkD = addPrimCfunREP(findText("D#"),1,0,DOUBLE_REP);
341 nameMkStable = addPrimCfunREP(findText("Stable#"),1,0,STABLE_REP);
342 nameMkInteger = addPrimCfunREP(findText("Integer#"),1,0,0);
343 #ifdef PROVIDE_FOREIGN
344 nameMkForeign = addPrimCfunREP(findText("Foreign#"),1,0,0);
347 nameMkWeak = addPrimCfunREP(findText("Weak#"),1,0,0);
349 nameMkPrimArray = addPrimCfunREP(findText("PrimArray#"),1,0,0);
350 nameMkPrimByteArray = addPrimCfunREP(findText("PrimByteArray#"),1,0,0);
351 nameMkRef = addPrimCfunREP(findText("Ref#"),1,0,0);
352 nameMkPrimMutableArray = addPrimCfunREP(findText("PrimMutableArray#"),1,0,0);
353 nameMkPrimMutableByteArray = addPrimCfunREP(findText("PrimMutableByteArray#"),1,0,0);
354 #ifdef PROVIDE_CONCURRENT
355 nameMkThreadId = addPrimCfun(findTextREP("ThreadId#"),1,0,0);
356 nameMkMVar = addPrimCfun(findTextREP("MVar#"),1,0,0);
358 /* The following primitives are referred to in derived instances and
359 * hence require types; the following types are a little more general
360 * than we might like, but they are the closest we can get without a
361 * special datatype class.
363 name(nameConCmp).type
364 = mkPolyType(starToStar,fn(aVar,fn(aVar,typeOrdering)));
365 name(nameEnRange).type
366 = mkPolyType(starToStar,fn(boundPair,listof));
367 name(nameEnIndex).type
368 = mkPolyType(starToStar,fn(boundPair,fn(aVar,typeInt)));
369 name(nameEnInRng).type
370 = mkPolyType(starToStar,fn(boundPair,fn(aVar,typeBool)));
371 name(nameEnToEn).type
372 = mkPolyType(starToStar,fn(aVar,fn(typeInt,aVar)));
373 name(nameEnFrEn).type
374 = mkPolyType(starToStar,fn(aVar,typeInt));
375 name(nameEnFrom).type
376 = mkPolyType(starToStar,fn(aVar,listof));
377 name(nameEnFrTo).type
378 = name(nameEnFrTh).type
379 = mkPolyType(starToStar,fn(aVar,fn(aVar,listof)));
381 name(namePrimSeq).type
382 = primType(MONAD_Id, "ab", "b");
383 name(namePrimCatch).type
384 = primType(MONAD_Id, "aH", "a");
385 name(namePrimRaise).type
386 = primType(MONAD_Id, "E", "a");
388 for (i=2; i<=NUM_DTUPLES; i++) {/* Add derived instances of tuples */
389 addTupInst(classEq,i);
390 addTupInst(classOrd,i);
391 addTupInst(classIx,i);
392 addTupInst(classShow,i);
393 addTupInst(classRead,i);
394 addTupInst(classBounded,i);
399 static Void mkTypes ( void )
401 predNum = ap(classNum,aVar);
402 predFractional = ap(classFractional,aVar);
403 predIntegral = ap(classIntegral,aVar);
404 predMonad = ap(classMonad,aVar);
407 Void linkPreludeCM(void) { /* Hook to cfuns and mfuns in */
408 static Bool initialised = FALSE; /* prelude when first loaded */
413 setCurrModule(modulePrelude);
416 nameFalse = linkName("False");
417 nameTrue = linkName("True");
420 nameEq = linkName("==");
421 nameFromInt = linkName("fromInt");
422 nameFromInteger = linkName("fromInteger");
423 nameFromDouble = linkName("fromDouble");
424 nameReturn = linkName("return");
425 nameBind = linkName(">>=");
426 nameLe = linkName("<=");
427 nameGt = linkName(">");
428 nameShowsPrec = linkName("showsPrec");
429 nameReadsPrec = linkName("readsPrec");
430 nameEQ = linkName("EQ");
431 nameCompare = linkName("compare");
432 nameMinBnd = linkName("minBound");
433 nameMaxBnd = linkName("maxBound");
434 nameRange = linkName("range");
435 nameIndex = linkName("index");
436 namePlus = linkName("+");
437 nameMult = linkName("*");
438 nameRangeSize = linkName("rangeSize");
439 nameInRange = linkName("inRange");
440 nameMinus = linkName("-");
441 /* These come before calls to implementPrim */
442 for(i=0; i<NUM_TUPLES; ++i) {
448 Void linkPreludeNames(void) { /* Hook to names defined in Prelude */
449 static Bool initialised = FALSE;
454 setCurrModule(modulePrelude);
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]);
474 nameRunST = linkName("primRunST");
476 /* static(tidyInfix) */
477 nameNegate = linkName("negate");
479 nameRunIO = linkName("primRunIO");
480 namePrint = linkName("print");
482 nameOtherwise = linkName("otherwise");
483 nameUndefined = linkName("undefined");
486 namePmSub = linkName("primPmSub");
489 nameEqChar = linkName("primEqChar");
490 nameEqInt = linkName("primEqInt");
491 nameCreateAdjThunk = linkName("primCreateAdjThunk");
492 #if !OVERLOADED_CONSTANTS
493 nameEqInteger = linkName("primEqInteger");
494 #endif /* !OVERLOADED_CONSTANTS */
495 nameEqDouble = linkName("primEqDouble");
496 namePmInt = linkName("primPmInt");
497 name(namePmInt).inlineMe = TRUE;
502 /* ToDo: fix pFun (or eliminate its use) */
503 #define pFun(n,s) n = predefinePrim(s)
505 Void linkControl(what)
512 case INSTALL : linkControl(RESET);
514 modulePrelude = newModule(textPrelude);
515 setCurrModule(modulePrelude);
517 typeArrow = addPrimTycon(findText("(->)"),
518 pair(STAR,pair(STAR,STAR)),
521 /* newtype and USE_NEWTYPE_FOR_DICTS */
525 pFun(nameInd, "_indirect");
526 name(nameInd).number = DFUNNAME;
529 pFun(nameSel, "_SEL");
531 /* strict constructors */
532 pFun(nameFlip, "flip" );
535 pFun(nameFromTo, "enumFromTo");
536 pFun(nameFromThenTo, "enumFromThenTo");
537 pFun(nameFrom, "enumFrom");
538 pFun(nameFromThen, "enumFromThen");
542 pFun(nameReadParen, "readParen");
543 pFun(nameShowParen, "showParen");
544 pFun(nameLex, "lex");
545 pFun(nameEnToEn, "toEnumPR"); //not sure
546 pFun(nameEnFrEn, "fromEnum"); //not sure
547 pFun(nameEnFrom, "enumFrom"); //not sure
548 pFun(nameEnFrTh, "enumFromThen"); //not sure
549 pFun(nameEnFrTo, "enumFromTo"); //not sure
550 pFun(nameEnRange, "range"); //not sure
551 pFun(nameEnIndex, "index"); //not sure
552 pFun(nameEnInRng, "inRange"); //not sure
553 pFun(nameConCmp, "_concmp"); //very not sure
556 pFun(nameCompAux, "primCompAux");
557 name(nameCompAux).inlineMe = TRUE;
558 pFun(nameMap, "map");
560 /* implementTagToCon */
561 pFun(namePMFail, "primPmFail");
562 pFun(nameError, "error");
563 pFun(nameUnpackString, "primUnpackString");
565 // /* foreign export dynamic */
566 //pFun(nameCreateAdjThunk, "primCreateAdjThunk");
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 /*-------------------------------------------------------------------------*/