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/01/13 16:47:27 $
12 * ------------------------------------------------------------------------*/
18 #include "translate.h"
21 #include "Assembler.h" /* for asmPrimOps and AsmReps */
25 Module modulePreludeHugs;
27 Type typeArrow; /* Function spaces */
34 #ifdef PROVIDE_INTEGER
45 Type typePrimByteArray;
47 Type typePrimMutableArray;
48 Type typePrimMutableByteArray;
58 #ifdef PROVIDE_FOREIGN
61 #ifdef PROVIDE_CONCURRENT
74 Class classEq; /* `standard' classes */
85 Class classReal; /* `numeric' classes */
89 Class classFractional;
93 Class classMonad; /* Monads and monads with a zero */
96 List stdDefaults; /* standard default values */
98 Name nameTrue, nameFalse; /* primitive boolean constructors */
99 Name nameNil, nameCons; /* primitive list constructors */
100 Name nameUnit; /* primitive Unit type constructor */
103 Name nameFromInt, nameFromDouble; /* coercion of numerics */
104 Name nameFromInteger;
105 Name nameReturn, nameBind; /* for translating monad comps */
106 Name nameZero; /* for monads with a zero */
108 Name nameStrict; /* Members of class Eval */
117 Name nameUndefined; /* generic undefined value */
124 #if !OVERLOADED_CONSTANTS
133 Name namePmFromInteger;
135 Name nameUnpackString;
141 /* these names are required before we've had a chance to do the right thing */
143 Name nameUnsafeUnpackCString;
145 /* constructors used during translation and codegen */
146 Name nameMkC; /* Char# -> Char */
147 Name nameMkI; /* Int# -> Int */
149 Name nameMkInt64; /* Int64# -> Int64 */
151 #ifdef PROVIDE_INTEGER
152 Name nameMkInteger; /* Integer# -> Integer */
155 Name nameMkW; /* Word# -> Word */
158 Name nameMkA; /* Addr# -> Addr */
160 Name nameMkF; /* Float# -> Float */
161 Name nameMkD; /* Double# -> Double */
163 Name nameMkPrimArray;
164 Name nameMkPrimByteArray;
166 Name nameMkPrimMutableArray;
167 Name nameMkPrimMutableByteArray;
169 #ifdef PROVIDE_STABLE
170 Name nameMkStable; /* StablePtr# a -> StablePtr a */
173 Name nameMkWeak; /* Weak# a -> Weak a */
175 #ifdef PROVIDE_FOREIGN
176 Name nameMkForeign; /* ForeignObj# -> ForeignObj */
178 #ifdef PROVIDE_CONCURRENT
179 Name nameMkThreadId; /* ThreadId# -> ThreadId */
180 Name nameMkMVar; /* MVar# -> MVar */
183 /* --------------------------------------------------------------------------
185 * ------------------------------------------------------------------------*/
187 static Tycon linkTycon( String s );
188 static Tycon linkClass( String s );
189 static Name linkName ( String s );
191 static Tycon linkTycon( String s )
193 Tycon tc = findTycon(findText(s));
197 ERRMSG(0) "Prelude does not define standard type \"%s\"", s
201 static Class linkClass( String s )
203 Class cc = findClass(findText(s));
207 ERRMSG(0) "Prelude does not define standard class \"%s\"", s
211 static Name linkName( String s )
213 Name n = findName(findText(s));
217 ERRMSG(0) "Prelude does not define standard name \"%s\"", s
221 /* ToDo: kill this! */
222 static Name predefinePrim ( String s );
223 static Name predefinePrim ( String s )
225 Name nm = newName(findText(s));
226 name(nm).defn=PREDEFINED;
230 Void linkPreludeTC() { /* Hook to tycons and classes in */
231 static Bool initialised = FALSE; /* prelude when first loaded */
235 setCurrModule(modulePreludeHugs);
237 typeChar = linkTycon("Char");
238 typeInt = linkTycon("Int");
240 typeInt64 = linkTycon("Int64");
242 #ifdef PROVIDE_INTEGER
243 typeInteger = linkTycon("Integer");
246 typeWord = linkTycon("Word");
249 typeAddr = linkTycon("Addr");
252 typePrimArray = linkTycon("PrimArray");
253 typePrimByteArray = linkTycon("PrimByteArray");
254 typeRef = linkTycon("Ref");
255 typePrimMutableArray = linkTycon("PrimMutableArray");
256 typePrimMutableByteArray = linkTycon("PrimMutableByteArray");
258 typeFloat = linkTycon("Float");
259 typeDouble = linkTycon("Double");
260 #ifdef PROVIDE_STABLE
261 typeStable = linkTycon("StablePtr");
264 typeWeak = linkTycon("Weak");
266 #ifdef PROVIDE_FOREIGN
267 typeForeign = linkTycon("ForeignObj");
269 #ifdef PROVIDE_CONCURRENT
270 typeThreadId = linkTycon("ThreadId");
271 typeMVar = linkTycon("MVar");
274 typeBool = linkTycon("Bool");
275 typeST = linkTycon("ST");
276 typeIO = linkTycon("IO");
277 typeException = linkTycon("Exception");
278 typeList = linkTycon("[]");
279 typeUnit = linkTycon("()");
280 typeString = linkTycon("String");
282 classEq = linkClass("Eq");
283 classOrd = linkClass("Ord");
284 classIx = linkClass("Ix");
285 classEnum = linkClass("Enum");
286 classShow = linkClass("Show");
287 classRead = linkClass("Read");
288 classBounded = linkClass("Bounded");
290 classEval = linkClass("Eval");
292 classReal = linkClass("Real");
293 classIntegral = linkClass("Integral");
294 classRealFrac = linkClass("RealFrac");
295 classRealFloat = linkClass("RealFloat");
296 classFractional = linkClass("Fractional");
297 classFloating = linkClass("Floating");
298 classNum = linkClass("Num");
299 classMonad = linkClass("Monad");
300 classMonad0 = linkClass("MonadZero");
303 stdDefaults = cons(typeDouble,stdDefaults);
305 stdDefaults = cons(typeBignum,stdDefaults);
307 stdDefaults = cons(typeInt,stdDefaults);
311 nameMkC = addPrimCfun(findText("C#"),1,0,CHAR_REP);
312 nameMkI = addPrimCfun(findText("I#"),1,0,INT_REP);
314 nameMkInt64 = addPrimCfun(findText("Int64#"),1,0,INT64_REP);
317 nameMkW = addPrimCfun(findText("W#"),1,0,WORD_REP);
320 nameMkA = addPrimCfun(findText("A#"),1,0,ADDR_REP);
322 nameMkF = addPrimCfun(findText("F#"),1,0,FLOAT_REP);
323 nameMkD = addPrimCfun(findText("D#"),1,0,DOUBLE_REP);
324 #ifdef PROVIDE_STABLE
325 nameMkStable = addPrimCfun(findText("Stable#"),1,0,STABLE_REP);
328 #ifdef PROVIDE_INTEGER
329 nameMkInteger = addPrimCfun(findText("Integer#"),1,0,0);
331 #ifdef PROVIDE_FOREIGN
332 nameMkForeign = addPrimCfun(findText("Foreign#"),1,0,0);
335 nameMkWeak = addPrimCfun(findText("Weak#"),1,0,0);
338 nameMkPrimArray = addPrimCfun(findText("PrimArray#"),1,0,0);
339 nameMkPrimByteArray = addPrimCfun(findText("PrimByteArray#"),1,0,0);
340 nameMkRef = addPrimCfun(findText("Ref#"),1,0,0);
341 nameMkPrimMutableArray = addPrimCfun(findText("PrimMutableArray#"),1,0,0);
342 nameMkPrimMutableByteArray = addPrimCfun(findText("PrimMutableByteArray#"),1,0,0);
344 #ifdef PROVIDE_CONCURRENT
345 nameMkThreadId = addPrimCfun(findText("ThreadId#"),1,0,0);
346 nameMkMVar = addPrimCfun(findText("MVar#"),1,0,0);
350 addEvalInst(0,typeArrow,2,NIL); /* Add Eval instances for (->) */
353 for (i=2; i<=NUM_DTUPLES; i++) {/* Add derived instances of tuples */
355 addEvalInst(0,mkTuple(i),i,NIL);
358 addTupInst(classEq,i);
361 addTupInst(classOrd,i);
364 addTupInst(classIx,i);
367 addTupInst(classShow,i);
370 addTupInst(classRead,i);
373 addTupInst(classBounded,i);
379 Void linkPreludeCM() { /* Hook to cfuns and mfuns in */
380 static Bool initialised = FALSE; /* prelude when first loaded */
384 setCurrModule(modulePreludeHugs);
386 nameFalse = linkName("False");
387 nameTrue = linkName("True");
388 nameNil = linkName("[]");
389 nameCons = linkName(":");
390 nameUnit = linkName("()");
392 nameEq = linkName("==");
393 nameFromInt = linkName("fromInt");
394 nameFromInteger = linkName("fromInteger");
395 nameFromDouble = linkName("fromDouble");
397 nameStrict = linkName("strict");
398 nameSeq = linkName("seq");
400 nameReturn = linkName("return");
401 nameBind = linkName(">>=");
402 nameZero = linkName("zero");
404 /* These come before calls to implementPrim */
405 for(i=0; i<NUM_TUPLES; ++i) {
411 Void linkPreludeNames() { /* Hook to names defined in Prelude */
412 static Bool initialised = FALSE;
416 setCurrModule(modulePreludeHugs);
419 nameMkIO = linkName("primMkIO");
420 for (i=0; asmPrimOps[i].name; ++i) {
421 Text t = findText(asmPrimOps[i].name);
422 Name n = findName(t);
428 name(n).type = primType(asmPrimOps[i].monad,asmPrimOps[i].args,asmPrimOps[i].results);
429 name(n).arity = strlen(asmPrimOps[i].args);
430 name(n).primop = &(asmPrimOps[i]);
435 nameRunIO = linkName("primRunIO");
436 namePrint = linkName("print");
437 /* typechecker (undefined member functions) */
438 nameError = linkName("error");
440 nameId = linkName("id");
441 nameOtherwise = linkName("otherwise");
442 nameUndefined = linkName("undefined");
445 namePmSub = linkName("primPmSub");
448 nameUnpackString = linkName("primUnpackString");
449 namePMFail = linkName("primPmFail");
450 nameEqChar = linkName("primEqChar");
451 nameEqInt = linkName("primEqInt");
452 #if !OVERLOADED_CONSTANTS
453 nameEqInteger = linkName("primEqInteger");
454 #endif /* !OVERLOADED_CONSTANTS */
455 nameEqDouble = linkName("primEqDouble");
456 namePmInt = linkName("primPmInt");
457 namePmInteger = linkName("primPmInteger");
458 namePmDouble = linkName("primPmDouble");
459 namePmLe = linkName("primPmLe");
460 namePmSubtract = linkName("primPmSubtract");
461 namePmFromInteger = linkName("primPmFromInteger");
465 Void linkControl(what)
474 case INSTALL : linkControl(RESET);
476 modulePreludeHugs = newModule(findText("PreludeBuiltin"));
478 setCurrModule(modulePreludeHugs);
480 typeArrow = addPrimTycon(findText("(->)"),
481 pair(STAR,pair(STAR,STAR)),
484 /* ToDo: fix pFun (or eliminate its use) */
485 #define pFun(n,s,t) n = predefinePrim(s)
486 /* newtype and USE_NEWTYPE_FOR_DICTS */
487 pFun(nameId, "id", "id");
489 pFun(nameInd, "_indirect","error");
490 name(nameInd).number = DFUNNAME;
492 pFun(nameSel, "_SEL", "sel");
493 /* strict constructors */
494 pFun(nameForce, "primForce","id");
495 /* implementTagToCon */
496 pFun(namePMFail, "primPmFail","primPmFail");
497 pFun(nameError, "error","error");
498 pFun(nameUnpackString, "primUnpackString", "primUnpackString");
505 /*-------------------------------------------------------------------------*/