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/12 10:30:09 $
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 */
94 Name nameRunIO_toplevel;
98 Name nameUndefined; /* generic undefined value */
109 Name namePmFromInteger;
111 Name nameUnpackString;
114 Name nameCreateAdjThunk;
131 Name namePrimTakeMVar;
139 /* these names are required before we've had a chance to do the right thing */
141 Name nameUnsafeUnpackCString;
143 /* constructors used during translation and codegen */
144 Name nameMkC; /* Char# -> Char */
145 Name nameMkI; /* Int# -> Int */
146 Name nameMkInteger; /* Integer# -> Integer */
147 Name nameMkW; /* Word# -> Word */
148 Name nameMkA; /* Addr# -> Addr */
149 Name nameMkF; /* Float# -> Float */
150 Name nameMkD; /* Double# -> Double */
151 Name nameMkPrimArray;
152 Name nameMkPrimByteArray;
154 Name nameMkPrimMutableArray;
155 Name nameMkPrimMutableByteArray;
156 Name nameMkStable; /* StablePtr# a -> StablePtr a */
157 Name nameMkThreadId; /* ThreadId# -> ThreadId */
158 Name nameMkPrimMVar; /* MVar# a -> MVar a */
160 Name nameMkWeak; /* Weak# a -> Weak a */
162 #ifdef PROVIDE_FOREIGN
163 Name nameMkForeign; /* ForeignObj# -> ForeignObj */
183 Module modulePrelude;
188 /* --------------------------------------------------------------------------
189 * Frequently used type skeletons:
190 * ------------------------------------------------------------------------*/
192 Type arrow; /* mkOffset(0) -> mkOffset(1) */
193 Type boundPair; /* (mkOffset(0),mkOffset(0)) */
194 Type listof; /* [ mkOffset(0) ] */
195 Type typeVarToVar; /* mkOffset(0) -> mkOffset(0) */
197 Cell predNum; /* Num (mkOffset(0)) */
198 Cell predFractional; /* Fractional (mkOffset(0)) */
199 Cell predIntegral; /* Integral (mkOffset(0)) */
200 Kind starToStar; /* Type -> Type */
201 Cell predMonad; /* Monad (mkOffset(0)) */
202 Type typeProgIO; /* IO a */
205 /* --------------------------------------------------------------------------
207 * ------------------------------------------------------------------------*/
209 static Tycon linkTycon ( String s );
210 static Tycon linkClass ( String s );
211 static Name linkName ( String s );
212 static Name predefinePrim ( String s );
215 static Tycon linkTycon( String s )
217 Tycon tc = findTycon(findText(s));
218 if (nonNull(tc)) return tc;
220 tc = findTyconInAnyModule(findText(s));
221 if (nonNull(tc)) return tc;
223 fprintf(stderr, "frambozenvla! unknown tycon %s\n", s );
225 ERRMSG(0) "Prelude does not define standard type \"%s\"", s
229 static Class linkClass( String s )
231 Class cc = findClass(findText(s));
232 if (nonNull(cc)) return cc;
234 cc = findClassInAnyModule(findText(s));
235 if (nonNull(cc)) return cc;
237 fprintf(stderr, "frambozenvla! unknown class %s\n", s );
239 ERRMSG(0) "Prelude does not define standard class \"%s\"", s
243 static Name linkName( String s )
245 Name n = findName(findText(s));
246 if (nonNull(n)) return n;
248 n = findNameInAnyModule(findText(s));
249 if (nonNull(n)) return n;
251 fprintf(stderr, "frambozenvla! unknown name %s\n", s );
253 ERRMSG(0) "Prelude does not define standard name \"%s\"", s
257 static Name predefinePrim ( String s )
260 Text t = findText(s);
263 //fprintf(stderr, "predefinePrim: %s already exists\n", s );
266 name(nm).defn=PREDEFINED;
272 /* --------------------------------------------------------------------------
274 * ------------------------------------------------------------------------*/
276 /* In standalone mode, linkPreludeTC, linkPreludeCM and linkPreludeNames
277 are called, in that order, during static analysis of Prelude.hs.
278 In combined mode such an analysis does not happen. Instead these
279 calls will be made as a result of a call link(POSTPREL).
281 linkPreludeTC, linkPreludeCM and linkPreludeNames are needed in both
282 standalone and combined modes.
286 Void linkPreludeTC(void) { /* Hook to tycons and classes in */
287 static Bool initialised = FALSE; /* prelude when first loaded */
291 setCurrModule(modulePrelude);
293 typeChar = linkTycon("Char");
294 typeInt = linkTycon("Int");
295 typeInteger = linkTycon("Integer");
296 typeWord = linkTycon("Word");
297 typeAddr = linkTycon("Addr");
298 typePrimArray = linkTycon("PrimArray");
299 typePrimByteArray = linkTycon("PrimByteArray");
300 typeRef = linkTycon("STRef");
301 typePrimMutableArray = linkTycon("PrimMutableArray");
302 typePrimMutableByteArray = linkTycon("PrimMutableByteArray");
303 typeFloat = linkTycon("Float");
304 typeDouble = linkTycon("Double");
305 typeStable = linkTycon("StablePtr");
307 typeWeak = linkTycon("Weak");
309 # ifdef PROVIDE_FOREIGN
310 typeForeign = linkTycon("ForeignObj");
312 typeThreadId = linkTycon("ThreadId");
313 typeMVar = linkTycon("MVar");
314 typeBool = linkTycon("Bool");
315 typeST = linkTycon("ST");
316 typeIO = linkTycon("IO");
317 typeException = linkTycon("Exception");
318 typeString = linkTycon("String");
319 typeOrdering = linkTycon("Ordering");
321 classEq = linkClass("Eq");
322 classOrd = linkClass("Ord");
323 classIx = linkClass("Ix");
324 classEnum = linkClass("Enum");
325 classShow = linkClass("Show");
326 classRead = linkClass("Read");
327 classBounded = linkClass("Bounded");
328 classReal = linkClass("Real");
329 classIntegral = linkClass("Integral");
330 classRealFrac = linkClass("RealFrac");
331 classRealFloat = linkClass("RealFloat");
332 classFractional = linkClass("Fractional");
333 classFloating = linkClass("Floating");
334 classNum = linkClass("Num");
335 classMonad = linkClass("Monad");
336 assert(nonNull(typeDouble));
337 assert(nonNull(typeInteger));
339 stdDefaults = cons(typeDouble,stdDefaults);
341 stdDefaults = cons(typeInteger,stdDefaults);
343 stdDefaults = cons(typeInt,stdDefaults);
346 predNum = ap(classNum,aVar);
347 predFractional = ap(classFractional,aVar);
348 predIntegral = ap(classIntegral,aVar);
349 predMonad = ap(classMonad,aVar);
350 typeProgIO = ap(typeIO,aVar);
352 nameMkC = addPrimCfunREP(findText("C#"),1,0,CHAR_REP);
353 nameMkI = addPrimCfunREP(findText("I#"),1,0,INT_REP);
354 nameMkW = addPrimCfunREP(findText("W#"),1,0,WORD_REP);
355 nameMkA = addPrimCfunREP(findText("A#"),1,0,ADDR_REP);
356 nameMkF = addPrimCfunREP(findText("F#"),1,0,FLOAT_REP);
357 nameMkD = addPrimCfunREP(findText("D#"),1,0,DOUBLE_REP);
358 nameMkStable = addPrimCfunREP(findText("Stable#"),1,0,STABLE_REP);
359 nameMkThreadId = addPrimCfunREP(findText("ThreadId#"),1,0,THREADID_REP);
361 # ifdef PROVIDE_FOREIGN
362 nameMkForeign = addPrimCfunREP(findText("Foreign#"),1,0,0);
365 nameMkWeak = addPrimCfunREP(findText("Weak#"),1,0,0);
367 nameMkPrimArray = addPrimCfunREP(findText("PrimArray#"),1,0,0);
368 nameMkPrimByteArray = addPrimCfunREP(findText("PrimByteArray#"),1,0,0);
369 nameMkRef = addPrimCfunREP(findText("STRef#"),1,0,0);
370 nameMkPrimMutableArray = addPrimCfunREP(findText("PrimMutableArray#"),1,0,0);
371 nameMkPrimMutableByteArray = addPrimCfunREP(findText("PrimMutableByteArray#"),1,0,0);
372 nameMkPrimMVar = addPrimCfunREP(findText("MVar#"),1,0,0);
373 nameMkInteger = addPrimCfunREP(findText("Integer#"),1,0,0);
375 name(namePrimSeq).type = primType(MONAD_Id, "ab", "b");
376 name(namePrimCatch).type = primType(MONAD_Id, "aH", "a");
377 name(namePrimRaise).type = primType(MONAD_Id, "E", "a");
379 /* This is a lie. For a more accurate type of primTakeMVar
380 see ghc/interpreter/lib/Prelude.hs.
382 name(namePrimTakeMVar).type = primType(MONAD_Id, "rbc", "d");
385 for (i=2; i<=NUM_DTUPLES; i++) {/* Add derived instances of tuples */
386 addTupInst(classEq,i);
387 addTupInst(classOrd,i);
388 addTupInst(classIx,i);
389 addTupInst(classShow,i);
390 addTupInst(classRead,i);
391 addTupInst(classBounded,i);
397 Void linkPreludeCM(void) { /* Hook to cfuns and mfuns in */
398 static Bool initialised = FALSE; /* prelude when first loaded */
403 setCurrModule(modulePrelude);
406 nameFalse = linkName("False");
407 nameTrue = linkName("True");
410 nameEq = linkName("==");
411 nameFromInt = linkName("fromInt");
412 nameFromInteger = linkName("fromInteger");
413 nameFromDouble = linkName("fromDouble");
414 nameReturn = linkName("return");
415 nameBind = linkName(">>=");
416 nameLe = linkName("<=");
417 nameGt = linkName(">");
418 nameShowsPrec = linkName("showsPrec");
419 nameReadsPrec = linkName("readsPrec");
420 nameEQ = linkName("EQ");
421 nameCompare = linkName("compare");
422 nameMinBnd = linkName("minBound");
423 nameMaxBnd = linkName("maxBound");
424 nameRange = linkName("range");
425 nameIndex = linkName("index");
426 namePlus = linkName("+");
427 nameMult = linkName("*");
428 nameRangeSize = linkName("rangeSize");
429 nameInRange = linkName("inRange");
430 nameMinus = linkName("-");
431 /* These come before calls to implementPrim */
433 for(i=0; i<NUM_TUPLES; ++i) {
440 Void linkPreludeNames(void) { /* Hook to names defined in Prelude */
441 static Bool initialised = FALSE;
446 setCurrModule(modulePrelude);
449 nameMkIO = linkName("hugsprimMkIO");
452 for (i=0; asmPrimOps[i].name; ++i) {
453 Text t = findText(asmPrimOps[i].name);
454 Name n = findName(t);
460 name(n).type = primType(asmPrimOps[i].monad,
462 asmPrimOps[i].results);
463 name(n).arity = strlen(asmPrimOps[i].args);
464 name(n).primop = &(asmPrimOps[i]);
468 /* static(tidyInfix) */
469 nameNegate = linkName("negate");
471 nameRunIO_toplevel = linkName("hugsprimRunIO_toplevel");
472 nameShow = linkName("show");
473 namePutStr = linkName("putStr");
474 namePrint = linkName("print");
476 nameOtherwise = linkName("otherwise");
477 nameUndefined = linkName("undefined");
480 namePmSub = linkName("hugsprimPmSub");
483 nameEqChar = linkName("hugsprimEqChar");
484 nameCreateAdjThunk = linkName("hugsprimCreateAdjThunk");
485 namePmInt = linkName("hugsprimPmInt");
486 namePmInteger = linkName("hugsprimPmInteger");
487 namePmDouble = linkName("hugsprimPmDouble");
489 namePmFromInteger = linkName("hugsprimPmFromInteger");
490 namePmSubtract = linkName("hugsprimPmSubtract");
491 namePmLe = linkName("hugsprimPmLe");
493 implementCfun ( nameCons, NIL );
494 implementCfun ( nameNil, NIL );
495 implementCfun ( nameUnit, NIL );
500 /* --------------------------------------------------------------------------
502 * ------------------------------------------------------------------------*/
504 /* ToDo: fix pFun (or eliminate its use) */
505 #define pFun(n,s) n = predefinePrim(s)
507 Void linkControl(what)
516 Module modulePrelBase = findModule(findText("PrelBase"));
517 assert(nonNull(modulePrelBase));
519 fprintf(stderr, "linkControl(POSTPREL)\n");
521 setCurrModule(modulePrelude);
526 = mkCPtr(lookupOTabName(modulePrelBase, "PrelBase_ZMZN_static_closure"));
527 name(nameCons).stgVar
528 = mkCPtr(lookupOTabName(modulePrelBase, "PrelBase_ZC_closure"));
537 modulePrelude = findFakeModule(textPrelude);
538 module(modulePrelude).objectExtraNames
539 = singleton(findText("libHS_cbits"));
541 nameMkC = addWiredInBoxingTycon("PrelBase", "Char", "C#",CHAR_REP, STAR );
542 nameMkI = addWiredInBoxingTycon("PrelBase", "Int", "I#",INT_REP, STAR );
543 nameMkW = addWiredInBoxingTycon("PrelAddr", "Word", "W#",WORD_REP, STAR );
544 nameMkA = addWiredInBoxingTycon("PrelAddr", "Addr", "A#",ADDR_REP, STAR );
545 nameMkF = addWiredInBoxingTycon("PrelFloat","Float", "F#",FLOAT_REP, STAR );
546 nameMkD = addWiredInBoxingTycon("PrelFloat","Double","D#",DOUBLE_REP, STAR );
548 = addWiredInBoxingTycon("PrelNum","Integer","Integer#",0 ,STAR );
550 = addWiredInBoxingTycon("PrelGHC","ByteArray","PrimByteArray#",0 ,STAR );
552 for (i=0; i<NUM_TUPLES; ++i) {
555 addWiredInEnumTycon("PrelBase","Bool",
556 doubleton(findText("False"),findText("True")));
559 // = addWiredInBoxingTycon("PrelConc","ThreadId","ThreadId#"
560 // ,1,0,THREADID_REP);
562 setCurrModule(modulePrelude);
564 typeArrow = addPrimTycon(findText("(->)"),
565 pair(STAR,pair(STAR,STAR)),
568 pFun(nameInd, "_indirect");
569 name(nameInd).number = DFUNNAME;
573 modulePrelude = newModule(textPrelude);
574 setCurrModule(modulePrelude);
576 for (i=0; i<NUM_TUPLES; ++i) {
579 setCurrModule(modulePrelude);
581 typeArrow = addPrimTycon(findText("(->)"),
582 pair(STAR,pair(STAR,STAR)),
585 /* newtype and USE_NEWTYPE_FOR_DICTS */
589 pFun(nameInd, "_indirect");
590 name(nameInd).number = DFUNNAME;
593 pFun(nameSel, "_SEL");
595 /* strict constructors */
596 pFun(nameFlip, "flip" );
599 pFun(nameFromTo, "enumFromTo");
600 pFun(nameFromThenTo, "enumFromThenTo");
601 pFun(nameFrom, "enumFrom");
602 pFun(nameFromThen, "enumFromThen");
606 pFun(nameReadField, "readField");
607 pFun(nameReadParen, "readParen");
608 pFun(nameShowField, "showField");
609 pFun(nameShowParen, "showParen");
610 pFun(nameLex, "lex");
613 pFun(nameCompAux, "primCompAux");
614 pFun(nameMap, "map");
616 /* implementTagToCon */
617 pFun(namePMFail, "primPmFail");
618 pFun(nameError, "error");
619 pFun(nameUnpackString, "primUnpackString");
621 /* hooks for handwritten bytecode */
622 pFun(namePrimSeq, "primSeq");
623 pFun(namePrimCatch, "primCatch");
624 pFun(namePrimRaise, "primRaise");
625 pFun(namePrimTakeMVar, "primTakeMVar");
627 StgVar vv = mkStgVar(NIL,NIL);
628 Name n = namePrimSeq;
632 vv = mkStgVar(NIL,NIL);
633 stgVarInfo(vv) = mkPtr ( asm_BCO_seq() );
635 stgGlobals=cons(pair(n,vv),stgGlobals);
639 StgVar vv = mkStgVar(NIL,NIL);
640 Name n = namePrimCatch;
644 stgVarInfo(vv) = mkPtr ( asm_BCO_catch() );
646 stgGlobals=cons(pair(n,vv),stgGlobals);
649 StgVar vv = mkStgVar(NIL,NIL);
650 Name n = namePrimRaise;
654 stgVarInfo(vv) = mkPtr ( asm_BCO_raise() );
656 stgGlobals=cons(pair(n,vv),stgGlobals);
659 StgVar vv = mkStgVar(NIL,NIL);
660 Name n = namePrimTakeMVar;
664 stgVarInfo(vv) = mkPtr ( asm_BCO_takeMVar() );
666 stgGlobals=cons(pair(n,vv),stgGlobals);
675 /*-------------------------------------------------------------------------*/