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: 1999/11/16 17:38:55 $
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 */
109 Name namePmFromInteger;
112 Name nameUnpackString;
115 Name nameCreateAdjThunk;
141 Name namePrimTakeMVar;
149 /* these names are required before we've had a chance to do the right thing */
151 Name nameUnsafeUnpackCString;
153 /* constructors used during translation and codegen */
154 Name nameMkC; /* Char# -> Char */
155 Name nameMkI; /* Int# -> Int */
156 Name nameMkInteger; /* Integer# -> Integer */
157 Name nameMkW; /* Word# -> Word */
158 Name nameMkA; /* Addr# -> Addr */
159 Name nameMkF; /* Float# -> Float */
160 Name nameMkD; /* Double# -> Double */
161 Name nameMkPrimArray;
162 Name nameMkPrimByteArray;
164 Name nameMkPrimMutableArray;
165 Name nameMkPrimMutableByteArray;
166 Name nameMkStable; /* StablePtr# a -> StablePtr a */
167 Name nameMkThreadId; /* ThreadId# -> ThreadId */
168 Name nameMkPrimMVar; /* MVar# a -> MVar a */
170 Name nameMkWeak; /* Weak# a -> Weak a */
172 #ifdef PROVIDE_FOREIGN
173 Name nameMkForeign; /* ForeignObj# -> ForeignObj */
193 Module modulePrelude;
198 /* --------------------------------------------------------------------------
199 * Frequently used type skeletons:
200 * ------------------------------------------------------------------------*/
202 Type arrow; /* mkOffset(0) -> mkOffset(1) */
203 Type boundPair; /* (mkOffset(0),mkOffset(0)) */
204 Type listof; /* [ mkOffset(0) ] */
205 Type typeVarToVar; /* mkOffset(0) -> mkOffset(0) */
207 Cell predNum; /* Num (mkOffset(0)) */
208 Cell predFractional; /* Fractional (mkOffset(0)) */
209 Cell predIntegral; /* Integral (mkOffset(0)) */
210 Kind starToStar; /* Type -> Type */
211 Cell predMonad; /* Monad (mkOffset(0)) */
213 /* --------------------------------------------------------------------------
215 * ------------------------------------------------------------------------*/
217 static Tycon linkTycon ( String s );
218 static Tycon linkClass ( String s );
219 static Name linkName ( String s );
220 static Void mkTypes ( void );
221 static Name predefinePrim ( String s );
224 static Tycon linkTycon( String s )
226 Tycon tc = findTycon(findText(s));
230 ERRMSG(0) "Prelude does not define standard type \"%s\"", s
234 static Class linkClass( String s )
236 Class cc = findClass(findText(s));
240 ERRMSG(0) "Prelude does not define standard class \"%s\"", s
244 static Name linkName( String s )
246 Name n = findName(findText(s));
250 ERRMSG(0) "Prelude does not define standard name \"%s\"", s
254 static Name predefinePrim ( String s )
257 Text t = findText(s);
260 //fprintf(stderr, "predefinePrim: %s already exists\n", s );
263 name(nm).defn=PREDEFINED;
268 Void linkPreludeTC(void) { /* Hook to tycons and classes in */
269 static Bool initialised = FALSE; /* prelude when first loaded */
273 setCurrModule(modulePrelude);
275 typeChar = linkTycon("Char");
276 typeInt = linkTycon("Int");
277 typeInteger = linkTycon("Integer");
278 typeWord = linkTycon("Word");
279 typeAddr = linkTycon("Addr");
280 typePrimArray = linkTycon("PrimArray");
281 typePrimByteArray = linkTycon("PrimByteArray");
282 typeRef = linkTycon("Ref");
283 typePrimMutableArray = linkTycon("PrimMutableArray");
284 typePrimMutableByteArray = linkTycon("PrimMutableByteArray");
285 typeFloat = linkTycon("Float");
286 typeDouble = linkTycon("Double");
287 typeStable = linkTycon("StablePtr");
289 typeWeak = linkTycon("Weak");
291 #ifdef PROVIDE_FOREIGN
292 typeForeign = linkTycon("ForeignObj");
294 typeThreadId = linkTycon("ThreadId");
295 typeMVar = linkTycon("MVar");
296 typeBool = linkTycon("Bool");
297 typeST = linkTycon("ST");
298 typeIO = linkTycon("IO");
299 typeException = linkTycon("Exception");
300 typeString = linkTycon("String");
301 typeOrdering = linkTycon("Ordering");
303 classEq = linkClass("Eq");
304 classOrd = linkClass("Ord");
305 classIx = linkClass("Ix");
306 classEnum = linkClass("Enum");
307 classShow = linkClass("Show");
308 classRead = linkClass("Read");
309 classBounded = linkClass("Bounded");
310 classReal = linkClass("Real");
311 classIntegral = linkClass("Integral");
312 classRealFrac = linkClass("RealFrac");
313 classRealFloat = linkClass("RealFloat");
314 classFractional = linkClass("Fractional");
315 classFloating = linkClass("Floating");
316 classNum = linkClass("Num");
317 classMonad = linkClass("Monad");
320 stdDefaults = cons(typeDouble,stdDefaults);
322 stdDefaults = cons(typeInteger,stdDefaults);
324 stdDefaults = cons(typeInt,stdDefaults);
328 nameMkC = addPrimCfunREP(findText("C#"),1,0,CHAR_REP);
329 nameMkI = addPrimCfunREP(findText("I#"),1,0,INT_REP);
330 nameMkW = addPrimCfunREP(findText("W#"),1,0,WORD_REP);
331 nameMkA = addPrimCfunREP(findText("A#"),1,0,ADDR_REP);
332 nameMkF = addPrimCfunREP(findText("F#"),1,0,FLOAT_REP);
333 nameMkD = addPrimCfunREP(findText("D#"),1,0,DOUBLE_REP);
334 nameMkStable = addPrimCfunREP(findText("Stable#"),1,0,STABLE_REP);
335 nameMkInteger = addPrimCfunREP(findText("Integer#"),1,0,0);
336 #ifdef PROVIDE_FOREIGN
337 nameMkForeign = addPrimCfunREP(findText("Foreign#"),1,0,0);
340 nameMkWeak = addPrimCfunREP(findText("Weak#"),1,0,0);
342 nameMkPrimArray = addPrimCfunREP(findText("PrimArray#"),1,0,0);
343 nameMkPrimByteArray = addPrimCfunREP(findText("PrimByteArray#"),1,0,0);
344 nameMkRef = addPrimCfunREP(findText("Ref#"),1,0,0);
345 nameMkPrimMutableArray = addPrimCfunREP(findText("PrimMutableArray#"),1,0,0);
346 nameMkPrimMutableByteArray = addPrimCfunREP(findText("PrimMutableByteArray#"),1,0,0);
347 nameMkThreadId = addPrimCfunREP(findText("ThreadId#"),1,0,0);
348 nameMkPrimMVar = addPrimCfunREP(findText("MVar#"),1,0,0);
350 /* The following primitives are referred to in derived instances and
351 * hence require types; the following types are a little more general
352 * than we might like, but they are the closest we can get without a
353 * special datatype class.
355 name(nameConCmp).type
356 = mkPolyType(starToStar,fn(aVar,fn(aVar,typeOrdering)));
357 name(nameEnRange).type
358 = mkPolyType(starToStar,fn(boundPair,listof));
359 name(nameEnIndex).type
360 = mkPolyType(starToStar,fn(boundPair,fn(aVar,typeInt)));
361 name(nameEnInRng).type
362 = mkPolyType(starToStar,fn(boundPair,fn(aVar,typeBool)));
363 name(nameEnToEn).type
364 = mkPolyType(starToStar,fn(aVar,fn(typeInt,aVar)));
365 name(nameEnFrEn).type
366 = mkPolyType(starToStar,fn(aVar,typeInt));
367 name(nameEnFrom).type
368 = mkPolyType(starToStar,fn(aVar,listof));
369 name(nameEnFrTo).type
370 = name(nameEnFrTh).type
371 = mkPolyType(starToStar,fn(aVar,fn(aVar,listof)));
373 name(namePrimSeq).type
374 = primType(MONAD_Id, "ab", "b");
375 name(namePrimCatch).type
376 = primType(MONAD_Id, "aH", "a");
377 name(namePrimRaise).type
378 = primType(MONAD_Id, "E", "a");
380 /* This is a lie. For a more accurate type of primTakeMVar
381 see ghc/interpreter/lib/Prelude.hs.
383 name(namePrimTakeMVar).type
384 = primType(MONAD_Id, "rbc", "d");
386 for (i=2; i<=NUM_DTUPLES; i++) {/* Add derived instances of tuples */
387 addTupInst(classEq,i);
388 addTupInst(classOrd,i);
389 addTupInst(classIx,i);
390 addTupInst(classShow,i);
391 addTupInst(classRead,i);
392 addTupInst(classBounded,i);
397 static Void mkTypes ( void )
399 predNum = ap(classNum,aVar);
400 predFractional = ap(classFractional,aVar);
401 predIntegral = ap(classIntegral,aVar);
402 predMonad = ap(classMonad,aVar);
405 Void linkPreludeCM(void) { /* Hook to cfuns and mfuns in */
406 static Bool initialised = FALSE; /* prelude when first loaded */
411 setCurrModule(modulePrelude);
414 nameFalse = linkName("False");
415 nameTrue = linkName("True");
418 nameEq = linkName("==");
419 nameFromInt = linkName("fromInt");
420 nameFromInteger = linkName("fromInteger");
421 nameFromDouble = linkName("fromDouble");
422 nameReturn = linkName("return");
423 nameBind = linkName(">>=");
424 nameLe = linkName("<=");
425 nameGt = linkName(">");
426 nameShowsPrec = linkName("showsPrec");
427 nameReadsPrec = linkName("readsPrec");
428 nameEQ = linkName("EQ");
429 nameCompare = linkName("compare");
430 nameMinBnd = linkName("minBound");
431 nameMaxBnd = linkName("maxBound");
432 nameRange = linkName("range");
433 nameIndex = linkName("index");
434 namePlus = linkName("+");
435 nameMult = linkName("*");
436 nameRangeSize = linkName("rangeSize");
437 nameInRange = linkName("inRange");
438 nameMinus = linkName("-");
439 /* These come before calls to implementPrim */
440 for(i=0; i<NUM_TUPLES; ++i) {
446 Void linkPreludeNames(void) { /* Hook to names defined in Prelude */
447 static Bool initialised = FALSE;
452 setCurrModule(modulePrelude);
455 nameMkIO = linkName("primMkIO");
456 for (i=0; asmPrimOps[i].name; ++i) {
457 Text t = findText(asmPrimOps[i].name);
458 Name n = findName(t);
464 name(n).type = primType(asmPrimOps[i].monad,
466 asmPrimOps[i].results);
467 name(n).arity = strlen(asmPrimOps[i].args);
468 name(n).primop = &(asmPrimOps[i]);
472 nameRunST = linkName("primRunST");
474 /* static(tidyInfix) */
475 nameNegate = linkName("negate");
477 nameRunIO = linkName("primRunIO");
478 namePrint = linkName("print");
480 nameOtherwise = linkName("otherwise");
481 nameUndefined = linkName("undefined");
484 namePmSub = linkName("primPmSub");
487 nameEqChar = linkName("primEqChar");
488 nameEqInt = linkName("primEqInt");
489 nameCreateAdjThunk = linkName("primCreateAdjThunk");
490 nameEqDouble = linkName("primEqDouble");
491 namePmInt = linkName("primPmInt");
492 namePmInteger = linkName("primPmInteger");
493 namePmDouble = linkName("primPmDouble");
498 /* ToDo: fix pFun (or eliminate its use) */
499 #define pFun(n,s) n = predefinePrim(s)
501 Void linkControl(what)
508 case INSTALL : linkControl(RESET);
510 modulePrelude = newModule(textPrelude);
511 setCurrModule(modulePrelude);
513 typeArrow = addPrimTycon(findText("(->)"),
514 pair(STAR,pair(STAR,STAR)),
517 /* newtype and USE_NEWTYPE_FOR_DICTS */
521 pFun(nameInd, "_indirect");
522 name(nameInd).number = DFUNNAME;
525 pFun(nameSel, "_SEL");
527 /* strict constructors */
528 pFun(nameFlip, "flip" );
531 pFun(nameFromTo, "enumFromTo");
532 pFun(nameFromThenTo, "enumFromThenTo");
533 pFun(nameFrom, "enumFrom");
534 pFun(nameFromThen, "enumFromThen");
538 pFun(nameReadField, "readField");
539 pFun(nameReadParen, "readParen");
540 pFun(nameShowField, "showField");
541 pFun(nameShowParen, "showParen");
542 pFun(nameLex, "lex");
543 pFun(nameEnToEn, "toEnumPR"); //not sure
544 pFun(nameEnFrEn, "fromEnum"); //not sure
545 pFun(nameEnFrom, "enumFrom"); //not sure
546 pFun(nameEnFrTh, "enumFromThen"); //not sure
547 pFun(nameEnFrTo, "enumFromTo"); //not sure
548 pFun(nameEnRange, "range"); //not sure
549 pFun(nameEnIndex, "index"); //not sure
550 pFun(nameEnInRng, "inRange"); //not sure
551 pFun(nameConCmp, "_concmp"); //very not sure
554 pFun(nameCompAux, "primCompAux");
555 pFun(nameMap, "map");
557 /* implementTagToCon */
558 pFun(namePMFail, "primPmFail");
559 pFun(nameError, "error");
560 pFun(nameUnpackString, "primUnpackString");
562 /* hooks for handwritten bytecode */
563 pFun(namePrimSeq, "primSeq");
564 pFun(namePrimCatch, "primCatch");
565 pFun(namePrimRaise, "primRaise");
566 pFun(namePrimTakeMVar, "primTakeMVar");
568 StgVar vv = mkStgVar(NIL,NIL);
569 Name n = namePrimSeq;
573 vv = mkStgVar(NIL,NIL);
574 stgVarInfo(vv) = mkPtr ( asm_BCO_seq() );
576 stgGlobals=cons(pair(n,vv),stgGlobals);
580 StgVar vv = mkStgVar(NIL,NIL);
581 Name n = namePrimCatch;
585 stgVarInfo(vv) = mkPtr ( asm_BCO_catch() );
587 stgGlobals=cons(pair(n,vv),stgGlobals);
590 StgVar vv = mkStgVar(NIL,NIL);
591 Name n = namePrimRaise;
595 stgVarInfo(vv) = mkPtr ( asm_BCO_raise() );
597 stgGlobals=cons(pair(n,vv),stgGlobals);
600 StgVar vv = mkStgVar(NIL,NIL);
601 Name n = namePrimTakeMVar;
605 stgVarInfo(vv) = mkPtr ( asm_BCO_takeMVar() );
607 stgGlobals=cons(pair(n,vv),stgGlobals);
615 /*-------------------------------------------------------------------------*/