* included in the distribution.
*
* $RCSfile: link.c,v $
- * $Revision: 1.48 $
- * $Date: 2000/03/10 14:53:00 $
+ * $Revision: 1.58 $
+ * $Date: 2000/04/07 16:22:12 $
* ------------------------------------------------------------------------*/
-#include "prelude.h"
+#include "hugsbasictypes.h"
#include "storage.h"
-#include "backend.h"
#include "connect.h"
#include "errors.h"
-#include "Assembler.h" /* for asmPrimOps and AsmReps */
-
-#include "link.h"
+#include "Assembler.h" /* for asmPrimOps and AsmReps */
+#include "Rts.h" /* to make Prelude.h palatable */
+#include "Prelude.h" /* for fixupRTStoPreludeRefs */
Type typeArrow; /* Function spaces */
Name nameFromThenTo;
Name nameNegate;
+Name nameAssert;
+Name nameAssertError;
+Name nameTangleMessage;
+Name nameIrrefutPatError;
+Name nameNoMethodBindingError;
+Name nameNonExhaustiveGuardsError;
+Name namePatError;
+Name nameRecSelError;
+Name nameRecConError;
+Name nameRecUpdError;
+
/* these names are required before we've had a chance to do the right thing */
Name nameSel;
Name nameUnsafeUnpackCString;
Name nameMult;
Name nameMFail;
Type typeOrdering;
+Module modulePrelPrim;
Module modulePrelude;
Name nameMap;
Name nameMinus;
-
/* --------------------------------------------------------------------------
* Frequently used type skeletons:
* ------------------------------------------------------------------------*/
tc = findTyconInAnyModule(findText(s));
if (nonNull(tc)) return tc;
}
-fprintf(stderr, "frambozenvla! unknown tycon %s\n", s );
+FPrintf(stderr, "frambozenvla! unknown tycon %s\n", s );
return NIL;
ERRMSG(0) "Prelude does not define standard type \"%s\"", s
EEND;
cc = findClassInAnyModule(findText(s));
if (nonNull(cc)) return cc;
}
-fprintf(stderr, "frambozenvla! unknown class %s\n", s );
+FPrintf(stderr, "frambozenvla! unknown class %s\n", s );
return NIL;
ERRMSG(0) "Prelude does not define standard class \"%s\"", s
EEND;
n = findNameInAnyModule(findText(s));
if (nonNull(n)) return n;
}
-fprintf(stderr, "frambozenvla! unknown name %s\n", s );
+FPrintf(stderr, "frambozenvla! unknown name %s\n", s );
return NIL;
ERRMSG(0) "Prelude does not define standard name \"%s\"", s
EEND;
*
* ------------------------------------------------------------------------*/
-/* In standalone mode, linkPreludeTC, linkPreludeCM and linkPrimitiveNames
+/* In standalone mode, linkPreludeTC, linkPreludeCM and linkPrimNames
are called, in that order, during static analysis of Prelude.hs.
In combined mode such an analysis does not happen. Instead these
calls will be made as a result of a call link(POSTPREL).
if (!initialised) {
Int i;
initialised = TRUE;
- setCurrModule(modulePrelude);
+ if (combined) {
+ setCurrModule(modulePrelude);
+ } else {
+ setCurrModule(modulePrelPrim);
+ }
typeChar = linkTycon("Char");
typeInt = linkTycon("Int");
stdDefaults = NIL;
stdDefaults = cons(typeDouble,stdDefaults);
-# if DEFAULT_BIGNUM
stdDefaults = cons(typeInteger,stdDefaults);
-# else
- stdDefaults = cons(typeInt,stdDefaults);
-# endif
predNum = ap(classNum,aVar);
predFractional = ap(classFractional,aVar);
nameMkPrimMVar = addPrimCfunREP(findText("MVar#"),1,0,0);
nameMkInteger = addPrimCfunREP(findText("Integer#"),1,0,0);
- name(namePrimSeq).type = primType(MONAD_Id, "ab", "b");
- name(namePrimCatch).type = primType(MONAD_Id, "aH", "a");
- name(namePrimRaise).type = primType(MONAD_Id, "E", "a");
+ if (!combined) {
+ name(namePrimSeq).type = primType(MONAD_Id, "ab", "b");
+ name(namePrimCatch).type = primType(MONAD_Id, "aH", "a");
+ name(namePrimRaise).type = primType(MONAD_Id, "E", "a");
- /* This is a lie. For a more accurate type of primTakeMVar
- see ghc/interpreter/lib/Prelude.hs.
- */
- name(namePrimTakeMVar).type = primType(MONAD_Id, "rbc", "d");
+ /* This is a lie. For a more accurate type of primTakeMVar
+ see ghc/interpreter/lib/Prelude.hs.
+ */
+ name(namePrimTakeMVar).type = primType(MONAD_Id, "rbc", "d");
+ }
if (!combined) {
for (i=2; i<=NUM_DTUPLES; i++) {/* Add derived instances of tuples */
Int i;
initialised = TRUE;
- setCurrModule(modulePrelude);
+ if (combined) {
+ setCurrModule(modulePrelude);
+ } else {
+ setCurrModule(modulePrelPrim);
+ }
/* constructors */
nameFalse = linkName("False");
}
}
-Void linkPrimitiveNames(void) { /* Hook to names defined in Prelude */
+Void linkPrimNames ( void ) { /* Hook to names defined in Prelude */
static Bool initialised = FALSE;
if (!initialised) {
initialised = TRUE;
- setCurrModule(modulePrelude);
+ if (combined) {
+ setCurrModule(modulePrelude);
+ } else {
+ setCurrModule(modulePrelPrim);
+ }
/* primops */
nameMkIO = linkName("hugsprimMkIO");
Name nm;
Module modulePrelBase = findModule(findText("PrelBase"));
assert(nonNull(modulePrelBase));
- fprintf(stderr, "linkControl(POSTPREL)\n");
- setCurrModule(modulePrelude);
+ /* fprintf(stderr, "linkControl(POSTPREL)\n"); */
+ setCurrModule(modulePrelude);
linkPreludeTC();
linkPreludeCM();
- linkPrimitiveNames();
+ linkPrimNames();
+ fixupRTStoPreludeRefs ( lookupObjName );
nameUnpackString = linkName("hugsprimUnpackString");
namePMFail = linkName("hugsprimPmFail");
/* implementTagToCon */
xyzzy(nameError, "hugsprimError");
+
typeStable = linkTycon("Stable");
typeRef = linkTycon("IORef");
// {Prim,PrimByte,PrimMutable,PrimMutableByte}Array ?
Module modulePrelBase;
modulePrelude = findFakeModule(textPrelude);
- module(modulePrelude).objectExtraNames
- = singleton(findText("libHS_cbits"));
- nameMkC = addWiredInBoxingTycon("PrelBase", "Char", "C#",CHAR_REP, STAR );
- nameMkI = addWiredInBoxingTycon("PrelBase", "Int", "I#",INT_REP, STAR );
- nameMkW = addWiredInBoxingTycon("PrelAddr", "Word", "W#",WORD_REP, STAR );
- nameMkA = addWiredInBoxingTycon("PrelAddr", "Addr", "A#",ADDR_REP, STAR );
- nameMkF = addWiredInBoxingTycon("PrelFloat","Float", "F#",FLOAT_REP, STAR );
- nameMkD = addWiredInBoxingTycon("PrelFloat","Double","D#",DOUBLE_REP, STAR );
+ nameMkC = addWiredInBoxingTycon("PrelBase", "Char", "C#",
+ CHAR_REP, STAR );
+ nameMkI = addWiredInBoxingTycon("PrelBase", "Int", "I#",
+ INT_REP, STAR );
+ nameMkW = addWiredInBoxingTycon("PrelAddr", "Word", "W#",
+ WORD_REP, STAR );
+ nameMkA = addWiredInBoxingTycon("PrelAddr", "Addr", "A#",
+ ADDR_REP, STAR );
+ nameMkF = addWiredInBoxingTycon("PrelFloat","Float", "F#",
+ FLOAT_REP, STAR );
+ nameMkD = addWiredInBoxingTycon("PrelFloat","Double","D#",
+ DOUBLE_REP, STAR );
nameMkInteger
- = addWiredInBoxingTycon("PrelNum","Integer","Integer#",0 ,STAR );
+ = addWiredInBoxingTycon("PrelNum","Integer","Integer#",
+ 0 ,STAR );
nameMkPrimByteArray
- = addWiredInBoxingTycon("PrelGHC","ByteArray","PrimByteArray#",0 ,STAR );
+ = addWiredInBoxingTycon("PrelGHC","ByteArray",
+ "PrimByteArray#",0 ,STAR );
for (i=0; i<NUM_TUPLES; ++i) {
if (i != 1) addTupleTycon(i);
}
addWiredInEnumTycon("PrelBase","Bool",
- doubleton(findText("False"),findText("True")));
+ doubleton(findText("False"),
+ findText("True")));
//nameMkThreadId
- // = addWiredInBoxingTycon("PrelConc","ThreadId","ThreadId#"
- // ,1,0,THREADID_REP);
+ // = addWiredInBoxingTycon("PrelConc","ThreadId","ThreadId#"
+ // ,1,0,THREADID_REP);
setCurrModule(modulePrelude);
nameId.
*/
modulePrelBase = findModule(findText("PrelBase"));
+ module(modulePrelBase).objectExtraNames
+ = singleton(findText("libHS_cbits"));
+
setCurrModule(modulePrelBase);
pFun(nameId, "id");
setCurrModule(modulePrelude);
} else {
+ fixupRTStoPreludeRefs(NULL);
- modulePrelude = newModule(textPrelude);
- setCurrModule(modulePrelude);
+ modulePrelPrim = findFakeModule(textPrelPrim);
+ modulePrelude = findFakeModule(textPrelude);
+ setCurrModule(modulePrelPrim);
for (i=0; i<NUM_TUPLES; ++i) {
if (i != 1) addTupleTycon(i);
}
- setCurrModule(modulePrelude);
+ setCurrModule(modulePrelPrim);
typeArrow = addPrimTycon(findText("(->)"),
pair(STAR,pair(STAR,STAR)),
pFun(nameError, "error");
pFun(nameUnpackString, "hugsprimUnpackString");
+ /* assertion and exception issues */
+ pFun(nameAssert, "assert");
+ pFun(nameAssertError, "assertError");
+ pFun(nameTangleMessage, "tangleMessager");
+ pFun(nameIrrefutPatError,
+ "irrefutPatError");
+ pFun(nameNoMethodBindingError,
+ "noMethodBindingError");
+ pFun(nameNonExhaustiveGuardsError,
+ "nonExhaustiveGuardsError");
+ pFun(namePatError, "patError");
+ pFun(nameRecSelError, "recSelError");
+ pFun(nameRecConError, "recConError");
+ pFun(nameRecUpdError, "recUpdError");
+
/* hooks for handwritten bytecode */
pFun(namePrimSeq, "primSeq");
pFun(namePrimCatch, "primCatch");
projects / ghc-hetmet.git / blobdiff