X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Flink.c;h=7e405d039cacd99969b6857da818c36f4bf93ebb;hb=f23ba2b294429ccbdeb80f0344ec08f6abf61bb7;hp=58f3956993602cafb42e140151d20755298cdc13;hpb=51464cf3beb83a0976f746f5c7c83381a8112516;p=ghc-hetmet.git diff --git a/ghc/interpreter/link.c b/ghc/interpreter/link.c index 58f3956..7e405d0 100644 --- a/ghc/interpreter/link.c +++ b/ghc/interpreter/link.c @@ -9,16 +9,17 @@ * included in the distribution. * * $RCSfile: link.c,v $ - * $Revision: 1.51 $ - * $Date: 2000/03/14 14:34:47 $ + * $Revision: 1.60 $ + * $Date: 2000/04/27 16:35:29 $ * ------------------------------------------------------------------------*/ -#include "prelude.h" +#include "hugsbasictypes.h" #include "storage.h" #include "connect.h" #include "errors.h" -#include "Assembler.h" /* for asmPrimOps and AsmReps */ - +#include "Rts.h" /* to make Prelude.h palatable */ +#include "Assembler.h" /* for asmPrimOps and AsmReps */ +#include "Prelude.h" /* for fixupRTStoPreludeRefs */ Type typeArrow; /* Function spaces */ @@ -132,6 +133,17 @@ Name nameFrom; 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; @@ -176,11 +188,11 @@ Name namePlus; Name nameMult; Name nameMFail; Type typeOrdering; +Module modulePrelPrim; Module modulePrelude; Name nameMap; Name nameMinus; - /* -------------------------------------------------------------------------- * Frequently used type skeletons: * ------------------------------------------------------------------------*/ @@ -216,7 +228,7 @@ static Tycon linkTycon( String s ) 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; @@ -230,7 +242,7 @@ static Class linkClass( String s ) 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; @@ -244,7 +256,7 @@ static Name linkName( String s ) 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; @@ -284,7 +296,11 @@ Void linkPreludeTC(void) { /* Hook to tycons and classes in */ if (!initialised) { Int i; initialised = TRUE; - setCurrModule(modulePrelude); + if (combined) { + setCurrModule(modulePrelude); + } else { + setCurrModule(modulePrelPrim); + } typeChar = linkTycon("Char"); typeInt = linkTycon("Int"); @@ -363,14 +379,16 @@ Void linkPreludeTC(void) { /* Hook to tycons and classes in */ 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 */ @@ -391,7 +409,11 @@ Void linkPreludeCM(void) { /* Hook to cfuns and mfuns in */ Int i; initialised = TRUE; - setCurrModule(modulePrelude); + if (combined) { + setCurrModule(modulePrelude); + } else { + setCurrModule(modulePrelPrim); + } /* constructors */ nameFalse = linkName("False"); @@ -434,7 +456,11 @@ Void linkPrimNames ( void ) { /* Hook to names defined in Prelude */ if (!initialised) { initialised = TRUE; - setCurrModule(modulePrelude); + if (combined) { + setCurrModule(modulePrelude); + } else { + setCurrModule(modulePrelPrim); + } /* primops */ nameMkIO = linkName("hugsprimMkIO"); @@ -517,8 +543,8 @@ Int what; { 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(); linkPrimNames(); @@ -557,6 +583,7 @@ assert(nonNull(namePMFail)); /* implementTagToCon */ xyzzy(nameError, "hugsprimError"); + typeStable = linkTycon("Stable"); typeRef = linkTycon("IORef"); // {Prim,PrimByte,PrimMutable,PrimMutableByte}Array ? @@ -619,29 +646,36 @@ assert(nonNull(namePMFail)); 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)"), pair(STAR,pair(STAR,STAR)), @@ -714,52 +752,57 @@ assert(nonNull(namePMFail)); 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"); pFun(namePrimRaise, "primRaise"); pFun(namePrimTakeMVar, "primTakeMVar"); { - StgVar vv = mkStgVar(NIL,NIL); - Name n = namePrimSeq; - name(n).line = 0; - name(n).arity = 1; - name(n).type = NIL; - vv = mkStgVar(NIL,NIL); - stgVarInfo(vv) = mkPtr ( asm_BCO_seq() ); - name(n).stgVar = vv; - stgGlobals=cons(pair(n,vv),stgGlobals); - namePrimSeq = n; + Name n = namePrimSeq; + name(n).line = 0; + name(n).arity = 1; + name(n).type = NIL; + name(n).closure = mkCPtr ( asm_BCO_seq() ); + addToCodeList ( modulePrelPrim, n ); } { - StgVar vv = mkStgVar(NIL,NIL); - Name n = namePrimCatch; - name(n).line = 0; - name(n).arity = 2; - name(n).type = NIL; - stgVarInfo(vv) = mkPtr ( asm_BCO_catch() ); - name(n).stgVar = vv; - stgGlobals=cons(pair(n,vv),stgGlobals); + Name n = namePrimCatch; + name(n).line = 0; + name(n).arity = 2; + name(n).type = NIL; + name(n).closure = mkCPtr ( asm_BCO_catch() ); + addToCodeList ( modulePrelPrim, n ); } { - StgVar vv = mkStgVar(NIL,NIL); - Name n = namePrimRaise; - name(n).line = 0; - name(n).arity = 1; - name(n).type = NIL; - stgVarInfo(vv) = mkPtr ( asm_BCO_raise() ); - name(n).stgVar = vv; - stgGlobals=cons(pair(n,vv),stgGlobals); + Name n = namePrimRaise; + name(n).line = 0; + name(n).arity = 1; + name(n).type = NIL; + name(n).closure = mkCPtr ( asm_BCO_raise() ); + addToCodeList ( modulePrelPrim, n ); } { - StgVar vv = mkStgVar(NIL,NIL); - Name n = namePrimTakeMVar; - name(n).line = 0; - name(n).arity = 2; - name(n).type = NIL; - stgVarInfo(vv) = mkPtr ( asm_BCO_takeMVar() ); - name(n).stgVar = vv; - stgGlobals=cons(pair(n,vv),stgGlobals); + Name n = namePrimTakeMVar; + name(n).line = 0; + name(n).arity = 2; + name(n).type = NIL; + name(n).closure = mkCPtr ( asm_BCO_takeMVar() ); + addToCodeList ( modulePrelPrim, n ); } } break; @@ -767,5 +810,4 @@ assert(nonNull(namePMFail)); } #undef pFun -//#include "fooble.c" /*-------------------------------------------------------------------------*/