[project @ 2000-02-14 11:13:11 by sewardj]

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

diff --git a/ghc/interpreter/link.c b/ghc/interpreter/link.c
index bb42e1c..d15a756 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.40 $
- * $Date: 2000/02/08 15:32:30 $
+ * $Revision: 1.43 $
+ * $Date: 2000/02/14 11:13:11 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -409,7 +409,6 @@ Void linkPreludeCM(void) {              /* Hook to cfuns and mfuns in      */
         nameEq           = linkName("==");
         nameFromInt      = linkName("fromInt");
         nameFromInteger  = linkName("fromInteger");
-        nameFromDouble   = linkName("fromDouble");
         nameReturn       = linkName("return");
         nameBind         = linkName(">>=");
         nameLe           = linkName("<=");
@@ -484,8 +483,10 @@ Void linkPreludeNames(void) {           /* Hook to names defined in Prelude */
         namePmInt          = linkName("hugsprimPmInt");
         namePmInteger      = linkName("hugsprimPmInteger");
         namePmDouble       = linkName("hugsprimPmDouble");
- 
+
+        nameFromDouble     = linkName("fromDouble");
         namePmFromInteger = linkName("hugsprimPmFromInteger");
+
         namePmSubtract    = linkName("hugsprimPmSubtract");
         namePmLe          = linkName("hugsprimPmLe");
 
@@ -515,6 +516,7 @@ Int what; {
                        break;
 
         case POSTPREL: {
+           Name nm;
            Module modulePrelBase = findModule(findText("PrelBase"));
            assert(nonNull(modulePrelBase));
           fprintf(stderr, "linkControl(POSTPREL)\n");
@@ -530,7 +532,7 @@ assert(nonNull(namePMFail));
 
 
                /* pmc                                   */
-               xyzzy(nameSel,            "_SEL");
+               pFun(nameSel,            "_SEL");
 
                /* strict constructors                   */
                xyzzy(nameFlip,           "flip"     );
@@ -543,9 +545,9 @@ assert(nonNull(namePMFail));
 
                /* deriving                              */
                xyzzy(nameApp,            "++");
-               xyzzy(nameReadField,      "readField");
+               xyzzy(nameReadField,      "hugsprimReadField");
                xyzzy(nameReadParen,      "readParen");
-               xyzzy(nameShowField,      "showField");
+               xyzzy(nameShowField,      "hugsprimShowField");
                xyzzy(nameShowParen,      "showParen");
                xyzzy(nameLex,            "lex");
                xyzzy(nameComp,           ".");
@@ -564,6 +566,44 @@ assert(nonNull(namePMFail));
            ifLinkConstrItbl ( nameTrue );
            ifLinkConstrItbl ( nameNil );
            ifLinkConstrItbl ( nameCons );
+
+           /* PrelErr.hi doesn't give a type for error, alas.  
+              So error never appears in any symbol table.
+              So we fake it by copying the table entry for
+              hugsprimError -- which is just a call to error.
+              Although we put it on the Prelude export list, we
+              have to claim internally that it lives in PrelErr, 
+              so that the correct symbol (PrelErr_error_closure)
+              is referred to.
+              Big Big Sigh.
+           */
+           nm            = newName ( findText("error"), NIL );
+           name(nm)      = name(nameError);
+           name(nm).mod  = findModule(findText("PrelErr"));
+           name(nm).text = findText("error");
+           setCurrModule(modulePrelude);
+           module(modulePrelude).exports
+              = cons ( nm, module(modulePrelude).exports );
+
+           /* Make nameListMonad be the builder fn for instance Monad [].
+              Standalone hugs does this with a disgusting hack in 
+              checkInstDefn() in static.c.  We have a slightly different
+              disgusting hack for the combined case.
+           */
+           {
+           Class cm;   /* :: Class   */
+           List  is;   /* :: [Inst]  */
+           cm = findClassInAnyModule(findText("Monad"));
+           assert(nonNull(cm));
+           is = cclass(cm).instances;
+           assert(nonNull(is));
+           while (nonNull(is) && snd(inst(hd(is)).head) != typeList)
+              is = tl(is);
+           assert(nonNull(is));
+           nameListMonad = inst(hd(is)).builder;
+           assert(nonNull(nameListMonad));
+           }
+
            break;
         }
         case PREPREL : 
@@ -651,9 +691,9 @@ assert(nonNull(namePMFail));
 
                /* deriving                              */
                pFun(nameApp,            "++");
-               pFun(nameReadField,      "readField");
+               pFun(nameReadField,      "hugsprimReadField");
                pFun(nameReadParen,      "readParen");
-               pFun(nameShowField,      "showField");
+               pFun(nameShowField,      "hugsprimShowField");
                pFun(nameShowParen,      "showParen");
                pFun(nameLex,            "lex");
                pFun(nameComp,           ".");