2 /* --------------------------------------------------------------------------
3 * Load symbols required from the Prelude
5 * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
6 * Yale Haskell Group, and the Oregon Graduate Institute of Science and
7 * Technology, 1994-1999, All rights reserved. It is distributed as
8 * free software under the license in the file "License", which is
9 * included in the distribution.
11 * $RCSfile: link.c,v $
13 * $Date: 2000/01/05 19:10:21 $
14 * ------------------------------------------------------------------------*/
21 #include "Assembler.h" /* for asmPrimOps and AsmReps */
26 Type typeArrow; /* Function spaces */
34 Type typePrimByteArray;
36 Type typePrimMutableArray;
37 Type typePrimMutableByteArray;
46 #ifdef PROVIDE_FOREIGN
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 */
107 Name namePmFromInteger;
109 Name nameUnpackString;
112 Name nameCreateAdjThunk;
129 Name namePrimTakeMVar;
137 /* these names are required before we've had a chance to do the right thing */
139 Name nameUnsafeUnpackCString;
141 /* constructors used during translation and codegen */
142 Name nameMkC; /* Char# -> Char */
143 Name nameMkI; /* Int# -> Int */
144 Name nameMkInteger; /* Integer# -> Integer */
145 Name nameMkW; /* Word# -> Word */
146 Name nameMkA; /* Addr# -> Addr */
147 Name nameMkF; /* Float# -> Float */
148 Name nameMkD; /* Double# -> Double */
149 Name nameMkPrimArray;
150 Name nameMkPrimByteArray;
152 Name nameMkPrimMutableArray;
153 Name nameMkPrimMutableByteArray;
154 Name nameMkStable; /* StablePtr# a -> StablePtr a */
155 Name nameMkThreadId; /* ThreadId# -> ThreadId */
156 Name nameMkPrimMVar; /* MVar# a -> MVar a */
158 Name nameMkWeak; /* Weak# a -> Weak a */
160 #ifdef PROVIDE_FOREIGN
161 Name nameMkForeign; /* ForeignObj# -> ForeignObj */
181 Module modulePrelude;
186 /* --------------------------------------------------------------------------
187 * Frequently used type skeletons:
188 * ------------------------------------------------------------------------*/
190 Type arrow; /* mkOffset(0) -> mkOffset(1) */
191 Type boundPair; /* (mkOffset(0),mkOffset(0)) */
192 Type listof; /* [ mkOffset(0) ] */
193 Type typeVarToVar; /* mkOffset(0) -> mkOffset(0) */
195 Cell predNum; /* Num (mkOffset(0)) */
196 Cell predFractional; /* Fractional (mkOffset(0)) */
197 Cell predIntegral; /* Integral (mkOffset(0)) */
198 Kind starToStar; /* Type -> Type */
199 Cell predMonad; /* Monad (mkOffset(0)) */
200 Type typeProgIO; /* IO a */
203 /* --------------------------------------------------------------------------
205 * ------------------------------------------------------------------------*/
207 static Tycon linkTycon ( String s );
208 static Tycon linkClass ( String s );
209 static Name linkName ( String s );
210 static Name predefinePrim ( String s );
213 static Tycon linkTycon( String s )
215 Tycon tc = findTycon(findText(s));
219 ERRMSG(0) "Prelude does not define standard type \"%s\"", s
223 static Class linkClass( String s )
225 Class cc = findClass(findText(s));
229 ERRMSG(0) "Prelude does not define standard class \"%s\"", s
233 static Name linkName( String s )
235 Name n = findName(findText(s));
239 ERRMSG(0) "Prelude does not define standard name \"%s\"", s
243 static Name predefinePrim ( String s )
246 Text t = findText(s);
249 //fprintf(stderr, "predefinePrim: %s already exists\n", s );
252 name(nm).defn=PREDEFINED;
258 /* --------------------------------------------------------------------------
260 * ------------------------------------------------------------------------*/
262 /* In standalone mode, linkPreludeTC, linkPreludeCM and linkPreludeNames
263 are called, in that order, during static analysis of Prelude.hs.
264 In combined mode such an analysis does not happen. Instead these
265 calls will be made as a result of a call link(POSTPREL).
267 linkPreludeTC, linkPreludeCM and linkPreludeNames are needed in both
268 standalone and combined modes.
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("STRef");
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 typeThreadId = linkTycon("ThreadId");
299 typeMVar = linkTycon("MVar");
300 typeBool = linkTycon("Bool");
301 typeST = linkTycon("ST");
302 typeIO = linkTycon("IO");
303 typeException = linkTycon("Exception");
304 typeString = linkTycon("String");
305 typeOrdering = linkTycon("Ordering");
307 classEq = linkClass("Eq");
308 classOrd = linkClass("Ord");
309 classIx = linkClass("Ix");
310 classEnum = linkClass("Enum");
311 classShow = linkClass("Show");
312 classRead = linkClass("Read");
313 classBounded = linkClass("Bounded");
314 classReal = linkClass("Real");
315 classIntegral = linkClass("Integral");
316 classRealFrac = linkClass("RealFrac");
317 classRealFloat = linkClass("RealFloat");
318 classFractional = linkClass("Fractional");
319 classFloating = linkClass("Floating");
320 classNum = linkClass("Num");
321 classMonad = linkClass("Monad");
324 stdDefaults = cons(typeDouble,stdDefaults);
326 stdDefaults = cons(typeInteger,stdDefaults);
328 stdDefaults = cons(typeInt,stdDefaults);
331 predNum = ap(classNum,aVar);
332 predFractional = ap(classFractional,aVar);
333 predIntegral = ap(classIntegral,aVar);
334 predMonad = ap(classMonad,aVar);
335 typeProgIO = ap(typeIO,aVar);
337 nameMkC = addPrimCfunREP(findText("C#"),1,0,CHAR_REP);
338 nameMkI = addPrimCfunREP(findText("I#"),1,0,INT_REP);
339 nameMkW = addPrimCfunREP(findText("W#"),1,0,WORD_REP);
340 nameMkA = addPrimCfunREP(findText("A#"),1,0,ADDR_REP);
341 nameMkF = addPrimCfunREP(findText("F#"),1,0,FLOAT_REP);
342 nameMkD = addPrimCfunREP(findText("D#"),1,0,DOUBLE_REP);
343 nameMkStable = addPrimCfunREP(findText("Stable#"),1,0,STABLE_REP);
344 nameMkThreadId = addPrimCfunREP(findText("ThreadId#"),1,0,THREADID_REP);
346 # ifdef PROVIDE_FOREIGN
347 nameMkForeign = addPrimCfunREP(findText("Foreign#"),1,0,0);
350 nameMkWeak = addPrimCfunREP(findText("Weak#"),1,0,0);
352 nameMkPrimArray = addPrimCfunREP(findText("PrimArray#"),1,0,0);
353 nameMkPrimByteArray = addPrimCfunREP(findText("PrimByteArray#"),1,0,0);
354 nameMkRef = addPrimCfunREP(findText("STRef#"),1,0,0);
355 nameMkPrimMutableArray = addPrimCfunREP(findText("PrimMutableArray#"),1,0,0);
356 nameMkPrimMutableByteArray = addPrimCfunREP(findText("PrimMutableByteArray#"),1,0,0);
357 nameMkPrimMVar = addPrimCfunREP(findText("MVar#"),1,0,0);
358 nameMkInteger = addPrimCfunREP(findText("Integer#"),1,0,0);
360 name(namePrimSeq).type = primType(MONAD_Id, "ab", "b");
361 name(namePrimCatch).type = primType(MONAD_Id, "aH", "a");
362 name(namePrimRaise).type = primType(MONAD_Id, "E", "a");
364 /* This is a lie. For a more accurate type of primTakeMVar
365 see ghc/interpreter/lib/Prelude.hs.
367 name(namePrimTakeMVar).type = primType(MONAD_Id, "rbc", "d");
369 for (i=2; i<=NUM_DTUPLES; i++) {/* Add derived instances of tuples */
370 addTupInst(classEq,i);
371 addTupInst(classOrd,i);
372 addTupInst(classIx,i);
373 addTupInst(classShow,i);
374 addTupInst(classRead,i);
375 addTupInst(classBounded,i);
380 Void linkPreludeCM(void) { /* Hook to cfuns and mfuns in */
381 static Bool initialised = FALSE; /* prelude when first loaded */
386 setCurrModule(modulePrelude);
389 nameFalse = linkName("False");
390 nameTrue = linkName("True");
393 nameEq = linkName("==");
394 nameFromInt = linkName("fromInt");
395 nameFromInteger = linkName("fromInteger");
396 nameFromDouble = linkName("fromDouble");
397 nameReturn = linkName("return");
398 nameBind = linkName(">>=");
399 nameLe = linkName("<=");
400 nameGt = linkName(">");
401 nameShowsPrec = linkName("showsPrec");
402 nameReadsPrec = linkName("readsPrec");
403 nameEQ = linkName("EQ");
404 nameCompare = linkName("compare");
405 nameMinBnd = linkName("minBound");
406 nameMaxBnd = linkName("maxBound");
407 nameRange = linkName("range");
408 nameIndex = linkName("index");
409 namePlus = linkName("+");
410 nameMult = linkName("*");
411 nameRangeSize = linkName("rangeSize");
412 nameInRange = linkName("inRange");
413 nameMinus = linkName("-");
414 /* These come before calls to implementPrim */
415 for(i=0; i<NUM_TUPLES; ++i) {
421 Void linkPreludeNames(void) { /* Hook to names defined in Prelude */
422 static Bool initialised = FALSE;
427 setCurrModule(modulePrelude);
430 nameMkIO = linkName("primMkIO");
431 for (i=0; asmPrimOps[i].name; ++i) {
432 Text t = findText(asmPrimOps[i].name);
433 Name n = findName(t);
439 name(n).type = primType(asmPrimOps[i].monad,
441 asmPrimOps[i].results);
442 name(n).arity = strlen(asmPrimOps[i].args);
443 name(n).primop = &(asmPrimOps[i]);
447 /* static(tidyInfix) */
448 nameNegate = linkName("negate");
450 nameRunIO = linkName("primRunIO_hugs_toplevel");
451 namePrint = linkName("print");
453 nameOtherwise = linkName("otherwise");
454 nameUndefined = linkName("undefined");
457 namePmSub = linkName("primPmSub");
460 nameEqChar = linkName("primEqChar");
461 nameCreateAdjThunk = linkName("primCreateAdjThunk");
462 namePmInt = linkName("primPmInt");
463 namePmInteger = linkName("primPmInteger");
464 namePmDouble = linkName("primPmDouble");
466 namePmFromInteger = linkName("primPmFromInteger");
467 namePmSubtract = linkName("primPmSubtract");
468 namePmLe = linkName("primPmLe");
470 implementCfun ( nameCons, NIL );
471 implementCfun ( nameNil, NIL );
472 implementCfun ( nameUnit, NIL );
477 /* --------------------------------------------------------------------------
479 * ------------------------------------------------------------------------*/
481 /* ToDo: fix pFun (or eliminate its use) */
482 #define pFun(n,s) n = predefinePrim(s)
484 Void linkControl(what)
494 fprintf(stderr, "linkControl(POSTPREL)\n");
496 if (combined) assert(0);
503 modulePrelude = findFakeModule(textPrelude);
504 module(modulePrelude).objectExtraNames
505 = singleton(findText("libHS_cbits"));
507 nameMkC = addWiredInBoxingTycon("PrelBase","Char", "C#",1,0,CHAR_REP );
508 nameMkI = addWiredInBoxingTycon("PrelBase","Int", "I#",1,0,INT_REP );
509 nameMkW = addWiredInBoxingTycon("PrelAddr","Word", "W#",1,0,WORD_REP );
510 nameMkA = addWiredInBoxingTycon("PrelAddr","Addr", "A#",1,0,ADDR_REP );
511 nameMkF = addWiredInBoxingTycon("PrelBase","Float", "F#",1,0,FLOAT_REP );
512 nameMkD = addWiredInBoxingTycon("PrelBase","Double","D#",1,0,DOUBLE_REP);
514 = addWiredInBoxingTycon("PrelBase","Integer","Integer#",1,0,0);
516 = addWiredInBoxingTycon("PrelGHC","ByteArray","PrimByteArray#",1,0,0);
518 for (i=0; i<NUM_TUPLES; ++i) {
521 addWiredInEnumTycon("PrelBase","Bool",
522 doubleton(findText("False"),findText("True")));
525 // = addWiredInBoxingTycon("PrelConc","ThreadId","ThreadId#"
526 // ,1,0,THREADID_REP);
528 setCurrModule(modulePrelude);
530 typeArrow = addPrimTycon(findText("(->)"),
531 pair(STAR,pair(STAR,STAR)),
535 modulePrelude = newModule(textPrelude);
536 setCurrModule(modulePrelude);
538 for (i=0; i<NUM_TUPLES; ++i) {
541 setCurrModule(modulePrelude);
543 typeArrow = addPrimTycon(findText("(->)"),
544 pair(STAR,pair(STAR,STAR)),
547 /* newtype and USE_NEWTYPE_FOR_DICTS */
551 pFun(nameInd, "_indirect");
552 name(nameInd).number = DFUNNAME;
555 pFun(nameSel, "_SEL");
557 /* strict constructors */
558 pFun(nameFlip, "flip" );
561 pFun(nameFromTo, "enumFromTo");
562 pFun(nameFromThenTo, "enumFromThenTo");
563 pFun(nameFrom, "enumFrom");
564 pFun(nameFromThen, "enumFromThen");
568 pFun(nameReadField, "readField");
569 pFun(nameReadParen, "readParen");
570 pFun(nameShowField, "showField");
571 pFun(nameShowParen, "showParen");
572 pFun(nameLex, "lex");
575 pFun(nameCompAux, "primCompAux");
576 pFun(nameMap, "map");
578 /* implementTagToCon */
579 pFun(namePMFail, "primPmFail");
580 pFun(nameError, "error");
581 pFun(nameUnpackString, "primUnpackString");
583 /* hooks for handwritten bytecode */
584 pFun(namePrimSeq, "primSeq");
585 pFun(namePrimCatch, "primCatch");
586 pFun(namePrimRaise, "primRaise");
587 pFun(namePrimTakeMVar, "primTakeMVar");
589 StgVar vv = mkStgVar(NIL,NIL);
590 Name n = namePrimSeq;
594 vv = mkStgVar(NIL,NIL);
595 stgVarInfo(vv) = mkPtr ( asm_BCO_seq() );
597 stgGlobals=cons(pair(n,vv),stgGlobals);
601 StgVar vv = mkStgVar(NIL,NIL);
602 Name n = namePrimCatch;
606 stgVarInfo(vv) = mkPtr ( asm_BCO_catch() );
608 stgGlobals=cons(pair(n,vv),stgGlobals);
611 StgVar vv = mkStgVar(NIL,NIL);
612 Name n = namePrimRaise;
616 stgVarInfo(vv) = mkPtr ( asm_BCO_raise() );
618 stgGlobals=cons(pair(n,vv),stgGlobals);
621 StgVar vv = mkStgVar(NIL,NIL);
622 Name n = namePrimTakeMVar;
626 stgVarInfo(vv) = mkPtr ( asm_BCO_takeMVar() );
628 stgGlobals=cons(pair(n,vv),stgGlobals);
637 /*-------------------------------------------------------------------------*/