[project @ 2000-03-13 10:53:55 by simonmar]

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

diff --git a/ghc/interpreter/link.c b/ghc/interpreter/link.c
index d15a756..269412d 100644 (file)
--- a/ghc/interpreter/link.c
+++ b/ghc/interpreter/link.c
@@ -9,18 +9,16 @@
  * included in the distribution.
  *
  * $RCSfile: link.c,v $
- * $Revision: 1.43 $
- * $Date: 2000/02/14 11:13:11 $
+ * $Revision: 1.49 $
+ * $Date: 2000/03/10 20:03:36 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
 #include "storage.h"
-#include "backend.h"
 #include "connect.h"
 #include "errors.h"
 #include "Assembler.h" /* for asmPrimOps and AsmReps */
 
-#include "link.h"
 
 
 Type typeArrow;                         /* Function spaces                 */
@@ -96,9 +94,7 @@ Name namePrint;
 
 Name nameOtherwise;
 Name nameUndefined;                     /* generic undefined value         */
-#if NPLUSK
 Name namePmSub; 
-#endif
 Name namePMFail;
 Name nameEqChar;
 Name namePmInt;
@@ -273,7 +269,7 @@ static Name predefinePrim ( String s )
  * 
  * ------------------------------------------------------------------------*/
 
-/* In standalone mode, linkPreludeTC, linkPreludeCM and linkPreludeNames
+/* In standalone mode, linkPreludeTC, linkPreludeCM and linkPrimitiveNames
    are called, in that order, during static analysis of Prelude.hs.
    In combined mode such an analysis does not happen.  Instead these
    calls will be made as a result of a call link(POSTPREL).
@@ -336,11 +332,7 @@ Void linkPreludeTC(void) {              /* Hook to tycons and classes in   */
 
         stdDefaults              = NIL;
         stdDefaults              = cons(typeDouble,stdDefaults);
-#       if DEFAULT_BIGNUM
         stdDefaults              = cons(typeInteger,stdDefaults);
-#       else
-        stdDefaults              = cons(typeInt,stdDefaults);
-#       endif
 
         predNum                  = ap(classNum,aVar);
         predFractional           = ap(classFractional,aVar);
@@ -411,6 +403,7 @@ Void linkPreludeCM(void) {              /* Hook to cfuns and mfuns in      */
         nameFromInteger  = linkName("fromInteger");
         nameReturn       = linkName("return");
         nameBind         = linkName(">>=");
+       nameMFail        = linkName("fail");
         nameLe           = linkName("<=");
         nameGt           = linkName(">");
         nameShowsPrec    = linkName("showsPrec");
@@ -435,10 +428,10 @@ Void linkPreludeCM(void) {              /* Hook to cfuns and mfuns in      */
     }
 }
 
-Void linkPreludeNames(void) {           /* Hook to names defined in Prelude */
+Void linkPrimitiveNames(void) {        /* Hook to names defined in Prelude */
     static Bool initialised = FALSE;
+
     if (!initialised) {
-        Int i;
         initialised = TRUE;
 
         setCurrModule(modulePrelude);
@@ -447,22 +440,29 @@ Void linkPreludeNames(void) {           /* Hook to names defined in Prelude */
         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);
-           }
+         Int i;
+         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);
+           } else {
+             ERRMSG(0) "Link Error in Prelude, surplus definition of \"%s\"", 
+                               asmPrimOps[i].name
+              EEND;          
+             // Name already defined!
+           }
+         }
         }
+
         /* static(tidyInfix)                        */
         nameNegate         = linkName("negate");
         /* user interface                           */
@@ -474,9 +474,7 @@ Void linkPreludeNames(void) {           /* Hook to names defined in Prelude */
         nameOtherwise      = linkName("otherwise");
         nameUndefined      = linkName("undefined");
         /* pmc                                      */
-#       if NPLUSK                      
         namePmSub          = linkName("hugsprimPmSub");
-#       endif                          
         /* translator                               */
         nameEqChar         = linkName("hugsprimEqChar");
         nameCreateAdjThunk = linkName("hugsprimCreateAdjThunk");
@@ -523,7 +521,7 @@ Int what; {
            setCurrModule(modulePrelude);
            linkPreludeTC();
            linkPreludeCM();
-           linkPreludeNames();
+           linkPrimitiveNames();
 
            nameUnpackString = linkName("hugsprimUnpackString");
            namePMFail       = linkName("hugsprimPmFail");
@@ -585,6 +583,14 @@ assert(nonNull(namePMFail));
            module(modulePrelude).exports
               = cons ( nm, module(modulePrelude).exports );
 
+           /* The GHC prelude doesn't seem to export Addr.  Add it to the
+              export list for the sake of compatibility with standalone mode.
+          */
+           module(modulePrelude).exports
+              = cons ( pair(typeAddr,DOTDOT), 
+                       module(modulePrelude).exports );
+           addTycon(typeAddr);
+
            /* 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
@@ -759,5 +765,5 @@ assert(nonNull(namePMFail));
 }
 #undef pFun
 
-#include "fooble.c"
+//#include "fooble.c"
 /*-------------------------------------------------------------------------*/