X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Flink.c;h=5d8e40b5a3b3c27b7c5459b901aea1d8e346ea87;hb=b034fbda464c20850831fc6f8b0c706b2afe34bd;hp=456adf2626134bbef4edfd0d5da4b5a6f32df0c3;hpb=810bbf81f6446cf6770a1de6a8b2e970fb69fec8;p=ghc-hetmet.git

diff --git a/ghc/interpreter/link.c b/ghc/interpreter/link.c
index 456adf2..5d8e40b 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.30 $
- * $Date: 2000/01/10 17:06:41 $
+ * $Revision: 1.37 $
+ * $Date: 2000/01/12 14:52:53 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -89,6 +89,8 @@ Name nameBind;             /* for translating monad comps     */
 Name nameZero;                          /* for monads with a zero          */
 
 Name nameId;
+Name nameShow;
+Name namePutStr;
 Name nameRunIO_toplevel;
 Name namePrint;
 
@@ -331,7 +333,8 @@ Void linkPreludeTC(void) {              /* Hook to tycons and classes in   */
         classFloating            = linkClass("Floating");
         classNum                 = linkClass("Num");
         classMonad               = linkClass("Monad");
-
+assert(nonNull(typeDouble));
+assert(nonNull(typeInteger));
         stdDefaults              = NIL;
         stdDefaults              = cons(typeDouble,stdDefaults);
 #       if DEFAULT_BIGNUM
@@ -378,13 +381,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);
+           }
         }
     }
 }
@@ -424,8 +429,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);
+           }
         }
     }
 }
@@ -439,27 +446,31 @@ 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_toplevel = linkName("hugsprimRunIO_toplevel");
+        nameShow           = linkName("show");
+        namePutStr         = linkName("putStr");
         namePrint          = linkName("print");
         /* desugar                                  */
         nameOtherwise      = linkName("otherwise");
@@ -469,11 +480,11 @@ Void linkPreludeNames(void) {           /* Hook to names defined in Prelude */
         namePmSub          = linkName("hugsprimPmSub");
 #       endif                          
         /* translator                               */
-        nameEqChar         = linkName("primEqChar");
-        nameCreateAdjThunk = linkName("primCreateAdjThunk");
+        nameEqChar         = linkName("hugsprimEqChar");
+        nameCreateAdjThunk = linkName("hugsprimCreateAdjThunk");
         namePmInt          = linkName("hugsprimPmInt");
         namePmInteger      = linkName("hugsprimPmInteger");
-        namePmDouble       = linkName("primPmDouble");
+        namePmDouble       = linkName("hugsprimPmDouble");
  
         namePmFromInteger = linkName("hugsprimPmFromInteger");
         namePmSubtract    = linkName("hugsprimPmSubtract");
@@ -501,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) {
@@ -521,19 +539,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")));
@@ -547,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);
 
@@ -595,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");