[project @ 2000-04-04 01:07:49 by andy]

Adding in support for split Hugs Prelude.
There are now two preludes.
(1) PrimPrel - the Prelude defintions, and the extra magic datatypes.
(2) Prelude  - the external interface for Prelude.

8 files changed, 66 insertions, 46 deletions

diff --git a/ghc/interpreter/connect.h b/ghc/interpreter/connect.h
index 3dacc5cadf..3c9d85868c 100644
--- a/ghc/interpreter/connect.h
+++ b/ghc/interpreter/connect.h
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: connect.h,v $
- * $Revision: 1.33 $
- * $Date: 2000/03/24 14:32:03 $
+ * $Revision: 1.34 $
+ * $Date: 2000/04/04 01:07:49 $
  * ------------------------------------------------------------------------*/
 
 /* --------------------------------------------------------------------------
@@ -18,6 +18,7 @@
  * Texts, Names, Instances, Classes, Types, Kinds and Modules
  * ------------------------------------------------------------------------*/
 
+extern Text  textPrimPrel;
 extern Text  textPrelude;
 extern Text  textNum;                   /* used to process default decls   */
 extern Text  textCcall;                 /* used to process foreign import  */
@@ -220,10 +221,9 @@ extern Type typeST;
 extern Type typeIO;
 extern Type typeException;
 
-
+extern Module modulePrimPrel;
 extern Module modulePrelude;
 
-
 extern Kind   starToStar;                /* Type -> Type                    */
 
 
diff --git a/ghc/interpreter/hugs.c b/ghc/interpreter/hugs.c
index 8b5785cad3..7a365b66b1 100644
--- a/ghc/interpreter/hugs.c
+++ b/ghc/interpreter/hugs.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: hugs.c,v $
- * $Revision: 1.52 $
- * $Date: 2000/03/31 04:13:27 $
+ * $Revision: 1.53 $
+ * $Date: 2000/04/04 01:07:49 $
  * ------------------------------------------------------------------------*/
 
 #include <setjmp.h>
@@ -906,8 +906,10 @@ static void mgFromList ( List /* of CONID */ modgList )
       for (u = module(mod).uses; nonNull(u); u=tl(u))
          usesT = cons(textOf(hd(u)),usesT);
       /* artifically give all modules a dependency on Prelude */
-      if (mT != textPrelude) 
+#if 0
+      if (mT != textPrelude && mT != textPrimPrel)
          usesT = cons(textPrelude,usesT);
+#endif
       adjList = cons(pair(mT,usesT),adjList);
    }
 
@@ -1518,8 +1520,9 @@ static Bool loadThePrelude ( void )
       achieveTargetModules();
       ok = elemMG(conPrelude) && elemMG(conPrelHugs);
    } else {
-      conPrelude    = mkCon(findText("Prelude"));
-      targetModules = singleton(conPrelude);
+      conPrelude    = mkCon(findText("PrimPrel"));
+      conPrelHugs   = mkCon(findText("Prelude"));
+      targetModules = doubleton(conPrelude,conPrelHugs);
       achieveTargetModules();
       ok = elemMG(conPrelude);
    }
@@ -1683,7 +1686,7 @@ static Module allocEvalModule ( void )
    module(evalMod).tycons  = module(currentModule).tycons;
    module(evalMod).classes = module(currentModule).classes;
    module(evalMod).qualImports 
-     = singleton(pair(mkCon(textPrelude),modulePrelude));
+     = singleton(pair(mkCon(textPrelude),modulePrimPrel)); /* AJG Back to Prelude */
    return evalMod;
 }
 
diff --git a/ghc/interpreter/input.c b/ghc/interpreter/input.c
index a21cc2b831..99c8ae960e 100644
--- a/ghc/interpreter/input.c
+++ b/ghc/interpreter/input.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: input.c,v $
- * $Revision: 1.24 $
- * $Date: 2000/03/24 14:32:03 $
+ * $Revision: 1.25 $
+ * $Date: 2000/04/04 01:07:49 $
  * ------------------------------------------------------------------------*/
 
 #include "hugsbasictypes.h"
@@ -151,6 +151,7 @@ Text   textCcall;                       /* ccall                           */
 Text   textStdcall;                     /* stdcall                         */
 
 Text   textNum;                         /* Num                             */
+Text   textPrimPrel;                    /* PrimPrel                        */
 Text   textPrelude;                     /* Prelude                         */
 Text   textPlus;                        /* (+)                             */
 
@@ -1699,6 +1700,7 @@ Int what; {
                        textBang       = findText("!");
                        textDot        = findText(".");
                        textImplies    = findText("=>");
+                       textPrimPrel   = findText("PrimPrel");
                        textPrelude    = findText("Prelude");
                        textNum        = findText("Num");
                        textModule     = findText("module");
diff --git a/ghc/interpreter/lib/Makefile b/ghc/interpreter/lib/Makefile
index aab3e2dbd7..8e1bcd27c9 100644
--- a/ghc/interpreter/lib/Makefile
+++ b/ghc/interpreter/lib/Makefile
@@ -1,11 +1,11 @@
 # -------------------------------------------------------------------------- #
-# $Id: Makefile,v 1.8 2000/03/20 04:26:23 andy Exp $ 
+# $Id: Makefile,v 1.9 2000/04/04 01:07:50 andy Exp $ 
 # -------------------------------------------------------------------------- #
 
 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
-PRELUDE  = Prelude.hs
+PRELUDE  = Prelude.hs PrimPrel.hs
 
 STD_LIBS = Array.lhs Char.lhs Complex.lhs CPUTime.lhs \
 	   Directory.lhs IO.lhs Ix.lhs List.lhs Locale.lhs \
diff --git a/ghc/interpreter/link.c b/ghc/interpreter/link.c
index 98235f3b97..09f147e6f3 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.54 $
- * $Date: 2000/03/23 14:54:21 $
+ * $Revision: 1.55 $
+ * $Date: 2000/04/04 01:07:49 $
  * ------------------------------------------------------------------------*/
 
 #include "hugsbasictypes.h"
@@ -188,11 +188,11 @@ Name namePlus;
 Name nameMult;
 Name nameMFail;
 Type typeOrdering;
+Module modulePrimPrel;
 Module modulePrelude;
 Name nameMap;
 Name nameMinus;
 
-
 /* --------------------------------------------------------------------------
  * Frequently used type skeletons:
  * ------------------------------------------------------------------------*/
@@ -296,7 +296,11 @@ Void linkPreludeTC(void) {              /* Hook to tycons and classes in   */
     if (!initialised) {
         Int i;
         initialised = TRUE;
-        setCurrModule(modulePrelude);
+	if (combined) {
+	  setCurrModule(modulePrelude);
+	} else {
+	  setCurrModule(modulePrimPrel);
+	}
 
         typeChar                 = linkTycon("Char");
         typeInt                  = linkTycon("Int");
@@ -405,7 +409,11 @@ Void linkPreludeCM(void) {              /* Hook to cfuns and mfuns in      */
         Int i;
         initialised = TRUE;
 
-        setCurrModule(modulePrelude);
+	if (combined) {
+	  setCurrModule(modulePrelude);
+	} else {
+	  setCurrModule(modulePrimPrel);
+	}
 
         /* constructors */
         nameFalse        = linkName("False");
@@ -448,7 +456,11 @@ Void linkPrimNames ( void ) {        /* Hook to names defined in Prelude */
     if (!initialised) {
         initialised = TRUE;
 
-        setCurrModule(modulePrelude);
+	if (combined) {
+	  setCurrModule(modulePrelude);
+	} else {
+	  setCurrModule(modulePrimPrel);
+	}
 
         /* primops */
         nameMkIO           = linkName("hugsprimMkIO");
@@ -532,7 +544,7 @@ Int what; {
            Module modulePrelBase = findModule(findText("PrelBase"));
            assert(nonNull(modulePrelBase));
 	   /* fprintf(stderr, "linkControl(POSTPREL)\n"); */
-           setCurrModule(modulePrelude);
+	   setCurrModule(modulePrelude);
            linkPreludeTC();
            linkPreludeCM();
            linkPrimNames();
@@ -596,7 +608,7 @@ assert(nonNull(namePMFail));
            name(nm).mod  = findModule(findText("PrelErr"));
            name(nm).text = findText("error");
            setCurrModule(modulePrelude);
-           module(modulePrelude).exports
+           module(modulePrimPrel).exports
               = cons ( nm, module(modulePrelude).exports );
 
            /* The GHC prelude doesn't seem to export Addr.  Add it to the
@@ -665,7 +677,7 @@ assert(nonNull(namePMFail));
                //   = addWiredInBoxingTycon("PrelConc","ThreadId","ThreadId#"
                //                           ,1,0,THREADID_REP);
 
-               setCurrModule(modulePrelude);
+               setCurrModule(modulePrimPrel);
 
                typeArrow = addPrimTycon(findText("(->)"),
                                         pair(STAR,pair(STAR,STAR)),
@@ -691,14 +703,14 @@ assert(nonNull(namePMFail));
            } else {
                fixupRTStoPreludeRefs(NULL);
 
-               modulePrelude = //newModule(textPrelude);
-                               findFakeModule(textPrelude);
-               setCurrModule(modulePrelude);
+               modulePrimPrel = findFakeModule(textPrimPrel);
+               modulePrelude = findFakeModule(textPrelude);
+               setCurrModule(modulePrimPrel);
         
                for (i=0; i<NUM_TUPLES; ++i) {
                    if (i != 1) addTupleTycon(i);
                }
-               setCurrModule(modulePrelude);
+               setCurrModule(modulePrimPrel);
 
                typeArrow = addPrimTycon(findText("(->)"),
                                         pair(STAR,pair(STAR,STAR)),
diff --git a/ghc/interpreter/static.c b/ghc/interpreter/static.c
index 8ee6aae42e..999e1e8d4a 100644
--- a/ghc/interpreter/static.c
+++ b/ghc/interpreter/static.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: static.c,v $
- * $Revision: 1.33 $
- * $Date: 2000/03/31 04:13:27 $
+ * $Revision: 1.34 $
+ * $Date: 2000/04/04 01:07:49 $
  * ------------------------------------------------------------------------*/
 
 #include "hugsbasictypes.h"
@@ -5035,18 +5035,21 @@ Void checkDefns ( Module thisModule ) { /* Top level static analysis       */
     mapProc(checkQualImport,  module(thisModule).qualImports);
     mapProc(checkUnqualImport,unqualImports);
     /* Add "import Prelude" if there`s no explicit import */
-    if (thisModule!=modulePrelude
-        && isNull(cellAssoc(modulePrelude,unqualImports))
-        && isNull(cellRevAssoc(modulePrelude,module(thisModule).qualImports))) {
-        unqualImports = cons(pair(modulePrelude,DOTDOT),unqualImports);
+#if 0
+    if (thisModule==modulePrelude || thisModule == modulePrelude2) {
+      /* Nothing. */
+    } else if (isNull(cellAssoc(modulePrelude,unqualImports))
+	       && isNull(cellRevAssoc(modulePrelude,module(thisModule).qualImports))) {
+      unqualImports = cons(pair(modulePrelude,DOTDOT),unqualImports);
     } else {
-        /* Every module (including the Prelude) implicitly contains 
-         * "import qualified Prelude" 
-         */
-        module(thisModule).qualImports
-           =cons(pair(mkCon(textPrelude),modulePrelude),
-                 module(thisModule).qualImports);
+      /* Every module (including the Prelude) implicitly contains 
+       * "import qualified Prelude" 
+       */
+      module(thisModule).qualImports
+	=cons(pair(mkCon(textPrelude),modulePrelude),
+	      module(thisModule).qualImports);
     }
+#endif
     mapProc(checkImportList, unqualImports);
 
     /* Note: there's a lot of side-effecting going on here, so
diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c
index efc5e47f44..8561d77d0f 100644
--- a/ghc/interpreter/storage.c
+++ b/ghc/interpreter/storage.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: storage.c,v $
- * $Revision: 1.58 $
- * $Date: 2000/04/03 23:43:13 $
+ * $Revision: 1.59 $
+ * $Date: 2000/04/04 01:07:49 $
  * ------------------------------------------------------------------------*/
 
 #include "hugsbasictypes.h"
@@ -1034,7 +1034,7 @@ Tycon addTupleTycon ( Int n )
 
    if (combined)
       m = findFakeModule(findText(n==0 ? "PrelBase" : "PrelTup")); else
-      m = findModule(findText("Prelude"));
+      m = findModule(findText("PrimPrel"));
 
    setCurrModule(m);
    k = STAR;
@@ -1718,7 +1718,7 @@ Void setCurrModule(m)              /* set lookup tables for current module */
 Module m; {
     Int i;
     assert(isModule(m));
-    /* fprintf(stderr, "SET CURR MODULE %s %d\n", textToStr(module(m).text),m);*/
+    /* fprintf(stderr, "SET CURR MODULE %s %d\n", textToStr(module(m).text),m); */
     {List t;
      for (t = module(m).names; nonNull(t); t=tl(t))
         assert(isName(hd(t)));
diff --git a/ghc/interpreter/type.c b/ghc/interpreter/type.c
index 3daf1d4978..c137513d6c 100644
--- a/ghc/interpreter/type.c
+++ b/ghc/interpreter/type.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: type.c,v $
- * $Revision: 1.31 $
- * $Date: 2000/03/23 14:54:21 $
+ * $Revision: 1.32 $
+ * $Date: 2000/04/04 01:07:49 $
  * ------------------------------------------------------------------------*/
 
 #include "hugsbasictypes.h"
@@ -2853,7 +2853,7 @@ Int what; {
            } else {
                dummyVar     = inventVar();
 
-               setCurrModule(modulePrelude);
+               setCurrModule(modulePrimPrel);
 
                starToStar   = simpleKind(1);