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/10 16:23:32 $
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));
216 if (nonNull(tc)) return tc;
218 tc = findTyconInAnyModule(findText(s));
219 if (nonNull(tc)) return tc;
221 fprintf(stderr, "frambozenvla! unknown tycon %s\n", s );
223 ERRMSG(0) "Prelude does not define standard type \"%s\"", s
227 static Class linkClass( String s )
229 Class cc = findClass(findText(s));
230 if (nonNull(cc)) return cc;
232 cc = findClassInAnyModule(findText(s));
233 if (nonNull(cc)) return cc;
235 fprintf(stderr, "frambozenvla! unknown class %s\n", s );
237 ERRMSG(0) "Prelude does not define standard class \"%s\"", s
241 static Name linkName( String s )
243 Name n = findName(findText(s));
244 if (nonNull(n)) return n;
246 n = findNameInAnyModule(findText(s));
247 if (nonNull(n)) return n;
249 fprintf(stderr, "frambozenvla! unknown name %s\n", s );
251 ERRMSG(0) "Prelude does not define standard name \"%s\"", s
255 static Name predefinePrim ( String s )
258 Text t = findText(s);
261 //fprintf(stderr, "predefinePrim: %s already exists\n", s );
264 name(nm).defn=PREDEFINED;
270 /* --------------------------------------------------------------------------
272 * ------------------------------------------------------------------------*/
274 /* In standalone mode, linkPreludeTC, linkPreludeCM and linkPreludeNames
275 are called, in that order, during static analysis of Prelude.hs.
276 In combined mode such an analysis does not happen. Instead these
277 calls will be made as a result of a call link(POSTPREL).
279 linkPreludeTC, linkPreludeCM and linkPreludeNames are needed in both
280 standalone and combined modes.
284 Void linkPreludeTC(void) { /* Hook to tycons and classes in */
285 static Bool initialised = FALSE; /* prelude when first loaded */
289 setCurrModule(modulePrelude);
291 typeChar = linkTycon("Char");
292 typeInt = linkTycon("Int");
293 typeInteger = linkTycon("Integer");
294 typeWord = linkTycon("Word");
295 typeAddr = linkTycon("Addr");
296 typePrimArray = linkTycon("PrimArray");
297 typePrimByteArray = linkTycon("PrimByteArray");
298 typeRef = linkTycon("STRef");
299 typePrimMutableArray = linkTycon("PrimMutableArray");
300 typePrimMutableByteArray = linkTycon("PrimMutableByteArray");
301 typeFloat = linkTycon("Float");
302 typeDouble = linkTycon("Double");
303 typeStable = linkTycon("StablePtr");
305 typeWeak = linkTycon("Weak");
307 # ifdef PROVIDE_FOREIGN
308 typeForeign = linkTycon("ForeignObj");
310 typeThreadId = linkTycon("ThreadId");
311 typeMVar = linkTycon("MVar");
312 typeBool = linkTycon("Bool");
313 typeST = linkTycon("ST");
314 typeIO = linkTycon("IO");
315 typeException = linkTycon("Exception");
316 typeString = linkTycon("String");
317 typeOrdering = linkTycon("Ordering");
319 classEq = linkClass("Eq");
320 classOrd = linkClass("Ord");
321 classIx = linkClass("Ix");
322 classEnum = linkClass("Enum");
323 classShow = linkClass("Show");
324 classRead = linkClass("Read");
325 classBounded = linkClass("Bounded");
326 classReal = linkClass("Real");
327 classIntegral = linkClass("Integral");
328 classRealFrac = linkClass("RealFrac");
329 classRealFloat = linkClass("RealFloat");
330 classFractional = linkClass("Fractional");
331 classFloating = linkClass("Floating");
332 classNum = linkClass("Num");
333 classMonad = linkClass("Monad");
336 stdDefaults = cons(typeDouble,stdDefaults);
338 stdDefaults = cons(typeInteger,stdDefaults);
340 stdDefaults = cons(typeInt,stdDefaults);
343 predNum = ap(classNum,aVar);
344 predFractional = ap(classFractional,aVar);
345 predIntegral = ap(classIntegral,aVar);
346 predMonad = ap(classMonad,aVar);
347 typeProgIO = ap(typeIO,aVar);
349 nameMkC = addPrimCfunREP(findText("C#"),1,0,CHAR_REP);
350 nameMkI = addPrimCfunREP(findText("I#"),1,0,INT_REP);
351 nameMkW = addPrimCfunREP(findText("W#"),1,0,WORD_REP);
352 nameMkA = addPrimCfunREP(findText("A#"),1,0,ADDR_REP);
353 nameMkF = addPrimCfunREP(findText("F#"),1,0,FLOAT_REP);
354 nameMkD = addPrimCfunREP(findText("D#"),1,0,DOUBLE_REP);
355 nameMkStable = addPrimCfunREP(findText("Stable#"),1,0,STABLE_REP);
356 nameMkThreadId = addPrimCfunREP(findText("ThreadId#"),1,0,THREADID_REP);
358 # ifdef PROVIDE_FOREIGN
359 nameMkForeign = addPrimCfunREP(findText("Foreign#"),1,0,0);
362 nameMkWeak = addPrimCfunREP(findText("Weak#"),1,0,0);
364 nameMkPrimArray = addPrimCfunREP(findText("PrimArray#"),1,0,0);
365 nameMkPrimByteArray = addPrimCfunREP(findText("PrimByteArray#"),1,0,0);
366 nameMkRef = addPrimCfunREP(findText("STRef#"),1,0,0);
367 nameMkPrimMutableArray = addPrimCfunREP(findText("PrimMutableArray#"),1,0,0);
368 nameMkPrimMutableByteArray = addPrimCfunREP(findText("PrimMutableByteArray#"),1,0,0);
369 nameMkPrimMVar = addPrimCfunREP(findText("MVar#"),1,0,0);
370 nameMkInteger = addPrimCfunREP(findText("Integer#"),1,0,0);
372 name(namePrimSeq).type = primType(MONAD_Id, "ab", "b");
373 name(namePrimCatch).type = primType(MONAD_Id, "aH", "a");
374 name(namePrimRaise).type = primType(MONAD_Id, "E", "a");
376 /* This is a lie. For a more accurate type of primTakeMVar
377 see ghc/interpreter/lib/Prelude.hs.
379 name(namePrimTakeMVar).type = primType(MONAD_Id, "rbc", "d");
381 for (i=2; i<=NUM_DTUPLES; i++) {/* Add derived instances of tuples */
382 addTupInst(classEq,i);
383 addTupInst(classOrd,i);
384 addTupInst(classIx,i);
385 addTupInst(classShow,i);
386 addTupInst(classRead,i);
387 addTupInst(classBounded,i);
392 Void linkPreludeCM(void) { /* Hook to cfuns and mfuns in */
393 static Bool initialised = FALSE; /* prelude when first loaded */
398 setCurrModule(modulePrelude);
401 nameFalse = linkName("False");
402 nameTrue = linkName("True");
405 nameEq = linkName("==");
406 nameFromInt = linkName("fromInt");
407 nameFromInteger = linkName("fromInteger");
408 nameFromDouble = linkName("fromDouble");
409 nameReturn = linkName("return");
410 nameBind = linkName(">>=");
411 nameLe = linkName("<=");
412 nameGt = linkName(">");
413 nameShowsPrec = linkName("showsPrec");
414 nameReadsPrec = linkName("readsPrec");
415 nameEQ = linkName("EQ");
416 nameCompare = linkName("compare");
417 nameMinBnd = linkName("minBound");
418 nameMaxBnd = linkName("maxBound");
419 nameRange = linkName("range");
420 nameIndex = linkName("index");
421 namePlus = linkName("+");
422 nameMult = linkName("*");
423 nameRangeSize = linkName("rangeSize");
424 nameInRange = linkName("inRange");
425 nameMinus = linkName("-");
426 /* These come before calls to implementPrim */
427 for(i=0; i<NUM_TUPLES; ++i) {
433 Void linkPreludeNames(void) { /* Hook to names defined in Prelude */
434 static Bool initialised = FALSE;
439 setCurrModule(modulePrelude);
442 nameMkIO = linkName("hugsprimMkIO");
443 for (i=0; asmPrimOps[i].name; ++i) {
444 Text t = findText(asmPrimOps[i].name);
445 Name n = findName(t);
451 name(n).type = primType(asmPrimOps[i].monad,
453 asmPrimOps[i].results);
454 name(n).arity = strlen(asmPrimOps[i].args);
455 name(n).primop = &(asmPrimOps[i]);
459 /* static(tidyInfix) */
460 nameNegate = linkName("negate");
462 nameRunIO = linkName("hugsprimRunIO_toplevel");
463 namePrint = linkName("print");
465 nameOtherwise = linkName("otherwise");
466 nameUndefined = linkName("undefined");
469 namePmSub = linkName("hugsprimPmSub");
472 nameEqChar = linkName("primEqChar");
473 nameCreateAdjThunk = linkName("hugsprimCreateAdjThunk");
474 namePmInt = linkName("hugsprimPmInt");
475 namePmInteger = linkName("hugsprimPmInteger");
476 namePmDouble = linkName("primPmDouble");
478 namePmFromInteger = linkName("hugsprimPmFromInteger");
479 namePmSubtract = linkName("hugsprimPmSubtract");
480 namePmLe = linkName("hugsprimPmLe");
482 implementCfun ( nameCons, NIL );
483 implementCfun ( nameNil, NIL );
484 implementCfun ( nameUnit, NIL );
489 /* --------------------------------------------------------------------------
491 * ------------------------------------------------------------------------*/
493 /* ToDo: fix pFun (or eliminate its use) */
494 #define pFun(n,s) n = predefinePrim(s)
496 Void linkControl(what)
506 fprintf(stderr, "linkControl(POSTPREL)\n");
508 setCurrModule(modulePrelude);
520 modulePrelude = findFakeModule(textPrelude);
521 module(modulePrelude).objectExtraNames
522 = singleton(findText("libHS_cbits"));
524 nameMkC = addWiredInBoxingTycon("PrelBase","Char", "C#",1,0,CHAR_REP );
525 nameMkI = addWiredInBoxingTycon("PrelBase","Int", "I#",1,0,INT_REP );
526 nameMkW = addWiredInBoxingTycon("PrelAddr","Word", "W#",1,0,WORD_REP );
527 nameMkA = addWiredInBoxingTycon("PrelAddr","Addr", "A#",1,0,ADDR_REP );
528 nameMkF = addWiredInBoxingTycon("PrelFloat","Float", "F#",1,0,FLOAT_REP );
529 nameMkD = addWiredInBoxingTycon("PrelFloat","Double","D#",1,0,DOUBLE_REP);
531 = addWiredInBoxingTycon("PrelNum","Integer","Integer#",1,0,0);
533 = addWiredInBoxingTycon("PrelGHC","ByteArray","PrimByteArray#",1,0,0);
535 for (i=0; i<NUM_TUPLES; ++i) {
538 addWiredInEnumTycon("PrelBase","Bool",
539 doubleton(findText("False"),findText("True")));
542 // = addWiredInBoxingTycon("PrelConc","ThreadId","ThreadId#"
543 // ,1,0,THREADID_REP);
545 setCurrModule(modulePrelude);
547 typeArrow = addPrimTycon(findText("(->)"),
548 pair(STAR,pair(STAR,STAR)),
552 modulePrelude = newModule(textPrelude);
553 setCurrModule(modulePrelude);
555 for (i=0; i<NUM_TUPLES; ++i) {
558 setCurrModule(modulePrelude);
560 typeArrow = addPrimTycon(findText("(->)"),
561 pair(STAR,pair(STAR,STAR)),
564 /* newtype and USE_NEWTYPE_FOR_DICTS */
568 pFun(nameInd, "_indirect");
569 name(nameInd).number = DFUNNAME;
572 pFun(nameSel, "_SEL");
574 /* strict constructors */
575 pFun(nameFlip, "flip" );
578 pFun(nameFromTo, "enumFromTo");
579 pFun(nameFromThenTo, "enumFromThenTo");
580 pFun(nameFrom, "enumFrom");
581 pFun(nameFromThen, "enumFromThen");
585 pFun(nameReadField, "readField");
586 pFun(nameReadParen, "readParen");
587 pFun(nameShowField, "showField");
588 pFun(nameShowParen, "showParen");
589 pFun(nameLex, "lex");
592 pFun(nameCompAux, "primCompAux");
593 pFun(nameMap, "map");
595 /* implementTagToCon */
596 pFun(namePMFail, "primPmFail");
597 pFun(nameError, "error");
598 pFun(nameUnpackString, "primUnpackString");
600 /* hooks for handwritten bytecode */
601 pFun(namePrimSeq, "primSeq");
602 pFun(namePrimCatch, "primCatch");
603 pFun(namePrimRaise, "primRaise");
604 pFun(namePrimTakeMVar, "primTakeMVar");
606 StgVar vv = mkStgVar(NIL,NIL);
607 Name n = namePrimSeq;
611 vv = mkStgVar(NIL,NIL);
612 stgVarInfo(vv) = mkPtr ( asm_BCO_seq() );
614 stgGlobals=cons(pair(n,vv),stgGlobals);
618 StgVar vv = mkStgVar(NIL,NIL);
619 Name n = namePrimCatch;
623 stgVarInfo(vv) = mkPtr ( asm_BCO_catch() );
625 stgGlobals=cons(pair(n,vv),stgGlobals);
628 StgVar vv = mkStgVar(NIL,NIL);
629 Name n = namePrimRaise;
633 stgVarInfo(vv) = mkPtr ( asm_BCO_raise() );
635 stgGlobals=cons(pair(n,vv),stgGlobals);
638 StgVar vv = mkStgVar(NIL,NIL);
639 Name n = namePrimTakeMVar;
643 stgVarInfo(vv) = mkPtr ( asm_BCO_takeMVar() );
645 stgGlobals=cons(pair(n,vv),stgGlobals);
654 /*-------------------------------------------------------------------------*/