[project @ 2000-01-12 14:52:53 by sewardj]

[ghc-hetmet.git] / ghc / interpreter / link.c

diff --git a/ghc/interpreter/link.c b/ghc/interpreter/link.c
index 3444cd4..5d8e40b 100644 (file)
--- a/ghc/interpreter/link.c
+++ b/ghc/interpreter/link.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: link.c,v $
- * $Revision: 1.33 $
- * $Date: 2000/01/11 15:40:57 $
+ * $Revision: 1.37 $
+ * $Date: 2000/01/12 14:52:53 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -381,15 +381,15 @@ assert(nonNull(typeInteger));
        */
         name(namePrimTakeMVar).type = primType(MONAD_Id, "rbc", "d");
 
-        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);
-        }
+        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);
+           }
         }
     }
 }
@@ -429,10 +429,10 @@ Void linkPreludeCM(void) {              /* Hook to cfuns and mfuns in      */
         nameInRange      = linkName("inRange");
         nameMinus        = linkName("-");
         /* These come before calls to implementPrim */
-        if (combined) {
-        for(i=0; i<NUM_TUPLES; ++i) {
-            implementTuple(i);
-        }
+        if (!combined) {
+           for(i=0; i<NUM_TUPLES; ++i) {
+               if (i != 1) implementTuple(i);
+           }
         }
     }
 }
@@ -512,18 +512,25 @@ Int what; {
         case MARK    : 
                        break;
 
-        case POSTPREL: 
+        case POSTPREL: {
+           Module modulePrelBase = findModule(findText("PrelBase"));
+           assert(nonNull(modulePrelBase));
 #if 1
-         fprintf(stderr, "linkControl(POSTPREL)\n");
+          fprintf(stderr, "linkControl(POSTPREL)\n");
 #if 1
-          setCurrModule(modulePrelude);
-          linkPreludeTC();
-          linkPreludeCM();
-          linkPreludeNames();
+           setCurrModule(modulePrelude);
+           linkPreludeTC();
+           linkPreludeCM();
+           linkPreludeNames();
+           name(nameNil).stgVar
+              = mkCPtr(lookupOTabName(modulePrelBase, "PrelBase_ZMZN_static_closure"));
+           name(nameCons).stgVar 
+              = mkCPtr(lookupOTabName(modulePrelBase, "PrelBase_ZC_closure"));
+           nameUnpackString = linkName("hugsprimUnpackString");
 #endif
 #endif
-          break;
-
+           break;
+        }
         case PREPREL : 
 
            if (combined) {
@@ -544,7 +551,7 @@ Int what; {
                        = 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")));
@@ -558,13 +565,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);
 
@@ -606,7 +617,7 @@ Int what; {
                /* implementTagToCon                     */
                pFun(namePMFail,         "primPmFail");
                pFun(nameError,          "error");
-               pFun(nameUnpackString,   "primUnpackString");
+               pFun(nameUnpackString,   "hugsprimUnpackString");
 
                /* hooks for handwritten bytecode */
                pFun(namePrimSeq,        "primSeq");