X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Flink.c;h=652c46e5603614a6a78cb4185811efcce63a50cd;hb=f0ee8b7265e07c735539d47ea646ca0cf0634d05;hp=74186f30d0de975fe1ae48ece0bb957f37c145a0;hpb=48fd138cd94a488d519d79dd64281ca6d7a72ff1;p=ghc-hetmet.git

diff --git a/ghc/interpreter/link.c b/ghc/interpreter/link.c
index 74186f3..652c46e 100644
--- a/ghc/interpreter/link.c
+++ b/ghc/interpreter/link.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: link.c,v $
- * $Revision: 1.27 $
- * $Date: 2000/01/07 17:49:29 $
+ * $Revision: 1.38 $
+ * $Date: 2000/01/12 16:29:47 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -89,7 +89,9 @@ Name nameBind;             /* for translating monad comps     */
 Name nameZero;                          /* for monads with a zero          */
 
 Name nameId;
-Name nameRunIO;
+Name nameShow;
+Name namePutStr;
+Name nameRunIO_toplevel;
 Name namePrint;
 
 Name nameOtherwise;
@@ -213,9 +215,13 @@ static Name  predefinePrim ( String s );
 static Tycon linkTycon( String s )
 {
     Tycon tc = findTycon(findText(s));
-    if (nonNull(tc)) {
-        return tc;
+    if (nonNull(tc)) return tc;
+    if (combined) {
+       tc = findTyconInAnyModule(findText(s));
+       if (nonNull(tc)) return tc;
     }
+fprintf(stderr, "frambozenvla!  unknown tycon %s\n", s );
+return NIL;
     ERRMSG(0) "Prelude does not define standard type \"%s\"", s
     EEND;
 }
@@ -223,9 +229,13 @@ static Tycon linkTycon( String s )
 static Class linkClass( String s )
 {
     Class cc = findClass(findText(s));
-    if (nonNull(cc)) {
-        return cc;
-    }
+    if (nonNull(cc)) return cc;
+    if (combined) {
+       cc = findClassInAnyModule(findText(s));
+       if (nonNull(cc)) return cc;
+    }   
+fprintf(stderr, "frambozenvla!  unknown class %s\n", s );
+return NIL;
     ERRMSG(0) "Prelude does not define standard class \"%s\"", s
     EEND;
 }
@@ -233,9 +243,13 @@ static Class linkClass( String s )
 static Name linkName( String s )
 {
     Name n = findName(findText(s));
-    if (nonNull(n)) {
-        return n;
-    }
+    if (nonNull(n)) return n;
+    if (combined) {
+       n = findNameInAnyModule(findText(s));
+       if (nonNull(n)) return n;
+    }   
+fprintf(stderr, "frambozenvla!  unknown  name %s\n", s );
+return NIL;
     ERRMSG(0) "Prelude does not define standard name \"%s\"", s
     EEND;
 }
@@ -366,13 +380,15 @@ Void linkPreludeTC(void) {              /* Hook to tycons and classes in   */
 	*/
         name(namePrimTakeMVar).type = primType(MONAD_Id, "rbc", "d");
 
-        for (i=2; i<=NUM_DTUPLES; i++) {/* Add derived instances of tuples */
-            addTupInst(classEq,i);
-            addTupInst(classOrd,i);
-            addTupInst(classIx,i);
-            addTupInst(classShow,i);
-            addTupInst(classRead,i);
-            addTupInst(classBounded,i);
+        if (!combined) {
+           for (i=2; i<=NUM_DTUPLES; i++) {/* Add derived instances of tuples */
+               addTupInst(classEq,i);
+               addTupInst(classOrd,i);
+               addTupInst(classIx,i);
+               addTupInst(classShow,i);
+               addTupInst(classRead,i);
+               addTupInst(classBounded,i);
+           }
         }
     }
 }
@@ -412,8 +428,10 @@ Void linkPreludeCM(void) {              /* Hook to cfuns and mfuns in      */
         nameInRange      = linkName("inRange");
         nameMinus        = linkName("-");
         /* These come before calls to implementPrim */
-        for(i=0; i<NUM_TUPLES; ++i) {
-            implementTuple(i);
+        if (!combined) {
+           for(i=0; i<NUM_TUPLES; ++i) {
+               if (i != 1) implementTuple(i);
+           }
         }
     }
 }
@@ -427,49 +445,55 @@ Void linkPreludeNames(void) {           /* Hook to names defined in Prelude */
         setCurrModule(modulePrelude);
 
         /* primops */
-        nameMkIO           = linkName("primMkIO");
-        for (i=0; asmPrimOps[i].name; ++i) {
-            Text t = findText(asmPrimOps[i].name);
-            Name n = findName(t);
-            if (isNull(n)) {
-                n = newName(t,NIL);
-            }
-            name(n).line   = 0;
-            name(n).defn   = NIL;
-            name(n).type   = primType(asmPrimOps[i].monad,
-                                      asmPrimOps[i].args,
-                                      asmPrimOps[i].results);
-            name(n).arity  = strlen(asmPrimOps[i].args);
-            name(n).primop = &(asmPrimOps[i]);
-            implementPrim(n);
+        nameMkIO           = linkName("hugsprimMkIO");
+
+        if (!combined) {
+           for (i=0; asmPrimOps[i].name; ++i) {
+               Text t = findText(asmPrimOps[i].name);
+               Name n = findName(t);
+               if (isNull(n)) {
+                   n = newName(t,NIL);
+               }
+               name(n).line   = 0;
+               name(n).defn   = NIL;
+               name(n).type   = primType(asmPrimOps[i].monad,
+                                         asmPrimOps[i].args,
+                                         asmPrimOps[i].results);
+               name(n).arity  = strlen(asmPrimOps[i].args);
+               name(n).primop = &(asmPrimOps[i]);
+               implementPrim(n);
+           }
         }
-
         /* static(tidyInfix)                        */
         nameNegate         = linkName("negate");
         /* user interface                           */
-        nameRunIO          = linkName("primRunIO_hugs_toplevel");
+        nameRunIO_toplevel = linkName("hugsprimRunIO_toplevel");
+        nameShow           = linkName("show");
+        namePutStr         = linkName("putStr");
         namePrint          = linkName("print");
         /* desugar                                  */
         nameOtherwise      = linkName("otherwise");
         nameUndefined      = linkName("undefined");
         /* pmc                                      */
 #       if NPLUSK                      
-        namePmSub          = linkName("primPmSub");
+        namePmSub          = linkName("hugsprimPmSub");
 #       endif                          
         /* translator                               */
-        nameEqChar         = linkName("primEqChar");
-        nameCreateAdjThunk = linkName("primCreateAdjThunk");
-        namePmInt          = linkName("primPmInt");
-        namePmInteger      = linkName("primPmInteger");
-        namePmDouble       = linkName("primPmDouble");
+        nameEqChar         = linkName("hugsprimEqChar");
+        nameCreateAdjThunk = linkName("hugsprimCreateAdjThunk");
+        namePmInt          = linkName("hugsprimPmInt");
+        namePmInteger      = linkName("hugsprimPmInteger");
+        namePmDouble       = linkName("hugsprimPmDouble");
  
-        namePmFromInteger = linkName("primPmFromInteger");
-        namePmSubtract    = linkName("primPmSubtract");
-        namePmLe          = linkName("primPmLe");
-
-        implementCfun ( nameCons, NIL );
-        implementCfun ( nameNil, NIL );
-        implementCfun ( nameUnit, NIL );
+        namePmFromInteger = linkName("hugsprimPmFromInteger");
+        namePmSubtract    = linkName("hugsprimPmSubtract");
+        namePmLe          = linkName("hugsprimPmLe");
+
+        if (!combined) {
+           implementCfun ( nameCons, NIL );
+           implementCfun ( nameNil, NIL );
+           implementCfun ( nameUnit, NIL );
+        }
     }
 }
 
@@ -489,12 +513,23 @@ Int what; {
         case MARK    : 
                        break;
 
-        case POSTPREL: 
+        case POSTPREL: {
+           Module modulePrelBase = findModule(findText("PrelBase"));
+           assert(nonNull(modulePrelBase));
 #if 1
-	  fprintf(stderr, "linkControl(POSTPREL)\n");
-#endif
-          break;
+	   fprintf(stderr, "linkControl(POSTPREL)\n");
+#if 1
+           setCurrModule(modulePrelude);
+           linkPreludeTC();
+           linkPreludeCM();
+           linkPreludeNames();
 
+           nameUnpackString = linkName("hugsprimUnpackString");
+           namePMFail       = linkName("hugsprimPmFail");
+#endif
+#endif
+           break;
+        }
         case PREPREL : 
 
            if (combined) {
@@ -503,19 +538,19 @@ Int what; {
                module(modulePrelude).objectExtraNames 
                   = singleton(findText("libHS_cbits"));
 
-               nameMkC = addWiredInBoxingTycon("PrelBase","Char",  "C#",1,0,CHAR_REP  );
-               nameMkI = addWiredInBoxingTycon("PrelBase","Int",   "I#",1,0,INT_REP   );
-               nameMkW = addWiredInBoxingTycon("PrelAddr","Word",  "W#",1,0,WORD_REP  );
-               nameMkA = addWiredInBoxingTycon("PrelAddr","Addr",  "A#",1,0,ADDR_REP  );
-               nameMkF = addWiredInBoxingTycon("PrelFloat","Float", "F#",1,0,FLOAT_REP );
-               nameMkD = addWiredInBoxingTycon("PrelFloat","Double","D#",1,0,DOUBLE_REP);
+               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#",1,0,0);
+                       = addWiredInBoxingTycon("PrelNum","Integer","Integer#",0 ,STAR );
                nameMkPrimByteArray      
-                       = addWiredInBoxingTycon("PrelGHC","ByteArray","PrimByteArray#",1,0,0);
+                       = addWiredInBoxingTycon("PrelGHC","ByteArray","PrimByteArray#",0 ,STAR );
 
                for (i=0; i<NUM_TUPLES; ++i) {
-                   addTupleTycon(i);
+                   if (i != 1) addTupleTycon(i);
                }
 	       addWiredInEnumTycon("PrelBase","Bool",
                                    doubleton(findText("False"),findText("True")));
@@ -529,13 +564,17 @@ Int what; {
                typeArrow = addPrimTycon(findText("(->)"),
                                         pair(STAR,pair(STAR,STAR)),
                                         2,DATATYPE,NIL);
+
+               pFun(nameInd, "_indirect");
+               name(nameInd).number = DFUNNAME;
+
            } else {
 
                modulePrelude = newModule(textPrelude);
                setCurrModule(modulePrelude);
         
                for (i=0; i<NUM_TUPLES; ++i) {
-                   addTupleTycon(i);
+                   if (i != 1) addTupleTycon(i);
                }
                setCurrModule(modulePrelude);
 
@@ -575,9 +614,9 @@ Int what; {
                pFun(nameMap,            "map");
 
                /* implementTagToCon                     */
-               pFun(namePMFail,         "primPmFail");
+               pFun(namePMFail,         "hugsprimPmFail");
                pFun(nameError,          "error");
-               pFun(nameUnpackString,   "primUnpackString");
+               pFun(nameUnpackString,   "hugsprimUnpackString");
 
                /* hooks for handwritten bytecode */
                pFun(namePrimSeq,        "primSeq");