projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 2000-04-07 16:22:12 by sewardj]
[ghc-hetmet.git] / ghc / interpreter / link.c
diff --git a/ghc/interpreter/link.c b/ghc/interpreter/link.c
index 58f3956..31ac68d 100644 (file)
--- 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.58 $
+ * $Date: 2000/04/07 16:22:12 $
  * ------------------------------------------------------------------------*/
 
-#include "prelude.h"
+#include "hugsbasictypes.h"
 #include "storage.h"
 #include "connect.h"
 #include "errors.h"
-#include "Assembler.h" /* for asmPrimOps and AsmReps */
-
+#include "Assembler.h"                  /* for asmPrimOps and AsmReps      */
+#include "Rts.h"                        /* to make Prelude.h palatable     */
+#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<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);
 
@@ -659,6 +693,9 @@ assert(nonNull(namePMFail));
                   nameId. 
                */
                modulePrelBase = findModule(findText("PrelBase"));
+               module(modulePrelBase).objectExtraNames 
+                  = singleton(findText("libHS_cbits"));
+
                setCurrModule(modulePrelBase);
                pFun(nameId,             "id");
                setCurrModule(modulePrelude);
@@ -666,13 +703,14 @@ assert(nonNull(namePMFail));
            } 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)),
@@ -714,6 +752,21 @@ 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");
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)