[project @ 2000-01-10 16:23:32 by sewardj]

diff --git a/ghc/interpreter/lib/Prelude.hs b/ghc/interpreter/lib/Prelude.hs
index 8a1e04d..ce05049 100644 (file)
--- a/ghc/interpreter/lib/Prelude.hs
+++ b/ghc/interpreter/lib/Prelude.hs
@@ -1548,11 +1548,11 @@ readFloat r    = [(fromRational ((n%1)*10^^(k-d)),t) | (n,d,s) <- readFix r,
 primCompAux      :: Ord a => a -> a -> Ordering -> Ordering
 primCompAux x y o = case compare x y of EQ -> o; LT -> LT; GT -> GT
 
-primPmInt        :: Num a => Int -> a -> Bool
-primPmInt n x     = fromInt n == x
+hugsprimPmInt        :: Num a => Int -> a -> Bool
+hugsprimPmInt n x     = fromInt n == x
 
-primPmInteger    :: Num a => Integer -> a -> Bool
-primPmInteger n x = fromInteger n == x
+hugsprimPmInteger    :: Num a => Integer -> a -> Bool
+hugsprimPmInteger n x = fromInteger n == x
 
 primPmDouble     :: Fractional a => Double -> a -> Bool
 primPmDouble n x  = fromDouble n == x
@@ -1562,28 +1562,28 @@ primPmFail       :: a
 primPmFail        = error "Pattern Match Failure"
 
 -- used in desugaring Foreign functions
-primMkIO :: (RealWorld -> (a,RealWorld)) -> IO a
-primMkIO = ST
+hugsprimMkIO :: (RealWorld -> (a,RealWorld)) -> IO a
+hugsprimMkIO = ST
 
-primCreateAdjThunk :: (a -> b) -> String -> Char -> IO Addr
-primCreateAdjThunk fun typestr callconv
+hugsprimCreateAdjThunk :: (a -> b) -> String -> Char -> IO Addr
+hugsprimCreateAdjThunk fun typestr callconv
    = do sp <- makeStablePtr fun
         p  <- copy_String_to_cstring typestr  -- is never freed
         a  <- primCreateAdjThunkARCH sp p callconv
         return a
 
 -- The following primitives are only needed if (n+k) patterns are enabled:
-primPmSub           :: Integral a => Int -> a -> a
-primPmSub n x        = x - fromInt n
+hugsprimPmSub           :: Integral a => Int -> a -> a
+hugsprimPmSub n x        = x - fromInt n
 
-primPmFromInteger   :: Integral a => Integer -> a
-primPmFromInteger    = fromIntegral
+hugsprimPmFromInteger   :: Integral a => Integer -> a
+hugsprimPmFromInteger    = fromIntegral
 
-primPmSubtract      :: Integral a => a -> a -> a
-primPmSubtract x y   = x - y
+hugsprimPmSubtract      :: Integral a => a -> a -> a
+hugsprimPmSubtract x y   = x - y
 
-primPmLe            :: Integral a => a -> a -> Bool
-primPmLe x y         = x <= y
+hugsprimPmLe            :: Integral a => a -> a -> Bool
+hugsprimPmLe x y         = x <= y
 
 -- Unpack strings generated by the Hugs code generator.
 -- Strings can contain \0 provided they're coded right.
@@ -1842,8 +1842,8 @@ prelCleanupAfterRunAction :: IORef (Maybe (IO ()))
 prelCleanupAfterRunAction = primRunST (newIORef Nothing)
 
 -- used when Hugs invokes top level function
-primRunIO_hugs_toplevel :: IO a -> ()
-primRunIO_hugs_toplevel m
+hugsprimRunIO_toplevel :: IO a -> ()
+hugsprimRunIO_toplevel m
    = protect 5 (fst (unST composite_action realWorld))
      where
         composite_action

diff --git a/ghc/interpreter/link.c b/ghc/interpreter/link.c
index 74186f3..8db6b70 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.27 $
- * $Date: 2000/01/07 17:49:29 $
+ * $Revision: 1.28 $
+ * $Date: 2000/01/10 16:23:32 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -213,9 +213,13 @@ static Name  predefinePrim ( String s );
 static Tycon linkTycon( String s )
 {
     Tycon tc = findTycon(findText(s));
-    if (nonNull(tc)) {
-        return tc;
+    if (nonNull(tc)) return tc;
+    if (combined) {
+       tc = findTyconInAnyModule(findText(s));
+       if (nonNull(tc)) return tc;
     }
+fprintf(stderr, "frambozenvla!  unknown tycon %s\n", s );
+return NIL;
     ERRMSG(0) "Prelude does not define standard type \"%s\"", s
     EEND;
 }
@@ -223,9 +227,13 @@ static Tycon linkTycon( String s )
 static Class linkClass( String s )
 {
     Class cc = findClass(findText(s));
-    if (nonNull(cc)) {
-        return cc;
-    }
+    if (nonNull(cc)) return cc;
+    if (combined) {
+       cc = findClassInAnyModule(findText(s));
+       if (nonNull(cc)) return cc;
+    }   
+fprintf(stderr, "frambozenvla!  unknown class %s\n", s );
+return NIL;
     ERRMSG(0) "Prelude does not define standard class \"%s\"", s
     EEND;
 }
@@ -233,9 +241,13 @@ static Class linkClass( String s )
 static Name linkName( String s )
 {
     Name n = findName(findText(s));
-    if (nonNull(n)) {
-        return n;
-    }
+    if (nonNull(n)) return n;
+    if (combined) {
+       n = findNameInAnyModule(findText(s));
+       if (nonNull(n)) return n;
+    }   
+fprintf(stderr, "frambozenvla!  unknown  name %s\n", s );
+return NIL;
     ERRMSG(0) "Prelude does not define standard name \"%s\"", s
     EEND;
 }
@@ -427,7 +439,7 @@ Void linkPreludeNames(void) {           /* Hook to names defined in Prelude */
         setCurrModule(modulePrelude);
 
         /* primops */
-        nameMkIO           = linkName("primMkIO");
+        nameMkIO           = linkName("hugsprimMkIO");
         for (i=0; asmPrimOps[i].name; ++i) {
             Text t = findText(asmPrimOps[i].name);
             Name n = findName(t);
@@ -447,25 +459,25 @@ Void linkPreludeNames(void) {           /* Hook to names defined in Prelude */
         /* static(tidyInfix)                        */
         nameNegate         = linkName("negate");
         /* user interface                           */
-        nameRunIO          = linkName("primRunIO_hugs_toplevel");
+        nameRunIO          = linkName("hugsprimRunIO_toplevel");
         namePrint          = linkName("print");
         /* desugar                                  */
         nameOtherwise      = linkName("otherwise");
         nameUndefined      = linkName("undefined");
         /* pmc                                      */
 #       if NPLUSK                      
-        namePmSub          = linkName("primPmSub");
+        namePmSub          = linkName("hugsprimPmSub");
 #       endif                          
         /* translator                               */
         nameEqChar         = linkName("primEqChar");
-        nameCreateAdjThunk = linkName("primCreateAdjThunk");
-        namePmInt          = linkName("primPmInt");
-        namePmInteger      = linkName("primPmInteger");
+        nameCreateAdjThunk = linkName("hugsprimCreateAdjThunk");
+        namePmInt          = linkName("hugsprimPmInt");
+        namePmInteger      = linkName("hugsprimPmInteger");
         namePmDouble       = linkName("primPmDouble");
  
-        namePmFromInteger = linkName("primPmFromInteger");
-        namePmSubtract    = linkName("primPmSubtract");
-        namePmLe          = linkName("primPmLe");
+        namePmFromInteger = linkName("hugsprimPmFromInteger");
+        namePmSubtract    = linkName("hugsprimPmSubtract");
+        namePmLe          = linkName("hugsprimPmLe");
 
         implementCfun ( nameCons, NIL );
         implementCfun ( nameNil, NIL );
@@ -492,6 +504,12 @@ Int what; {
         case POSTPREL: 
 #if 1
          fprintf(stderr, "linkControl(POSTPREL)\n");
+#if 1
+          setCurrModule(modulePrelude);
+          linkPreludeTC();
+          linkPreludeCM();
+          linkPreludeNames();
+#endif
 #endif
           break;
 

diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c
index b35bb94..a302cb7 100644 (file)
--- a/ghc/interpreter/storage.c
+++ b/ghc/interpreter/storage.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: storage.c,v $
- * $Revision: 1.33 $
- * $Date: 2000/01/07 17:49:29 $
+ * $Revision: 1.34 $
+ * $Date: 2000/01/10 16:23:33 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -1209,6 +1209,29 @@ Tycon findQualTyconWithoutConsultingExportList ( QualId q )
    return NIL;
 }
 
+Tycon findTyconInAnyModule ( Text t )
+{
+   Tycon tc;
+   for (tc = TYCMIN; tc < tyconHw; tc++)
+      if (tycon(tc).text == t) return tc;
+   return NIL;
+}
+
+Class findClassInAnyModule ( Text t )
+{
+   Class cc;
+   for (cc = CLASSMIN; cc < classHw; cc++)
+      if (cclass(cc).text == t) return cc;
+   return NIL;
+}
+
+Name findNameInAnyModule ( Text t )
+{
+   Name nm;
+   for (nm = NAMEMIN; nm < nameHw; nm++)
+      if (name(nm).text == t) return nm;
+   return NIL;
+}
 
 /* Same deal, except for Names. */
 Name findQualNameWithoutConsultingExportList ( QualId q )

diff --git a/ghc/lib/hugs/Prelude.hs b/ghc/lib/hugs/Prelude.hs
index 8a1e04d..ce05049 100644 (file)
--- a/ghc/lib/hugs/Prelude.hs
+++ b/ghc/lib/hugs/Prelude.hs
@@ -1548,11 +1548,11 @@ readFloat r    = [(fromRational ((n%1)*10^^(k-d)),t) | (n,d,s) <- readFix r,
 primCompAux      :: Ord a => a -> a -> Ordering -> Ordering
 primCompAux x y o = case compare x y of EQ -> o; LT -> LT; GT -> GT
 
-primPmInt        :: Num a => Int -> a -> Bool
-primPmInt n x     = fromInt n == x
+hugsprimPmInt        :: Num a => Int -> a -> Bool
+hugsprimPmInt n x     = fromInt n == x
 
-primPmInteger    :: Num a => Integer -> a -> Bool
-primPmInteger n x = fromInteger n == x
+hugsprimPmInteger    :: Num a => Integer -> a -> Bool
+hugsprimPmInteger n x = fromInteger n == x
 
 primPmDouble     :: Fractional a => Double -> a -> Bool
 primPmDouble n x  = fromDouble n == x
@@ -1562,28 +1562,28 @@ primPmFail       :: a
 primPmFail        = error "Pattern Match Failure"
 
 -- used in desugaring Foreign functions
-primMkIO :: (RealWorld -> (a,RealWorld)) -> IO a
-primMkIO = ST
+hugsprimMkIO :: (RealWorld -> (a,RealWorld)) -> IO a
+hugsprimMkIO = ST
 
-primCreateAdjThunk :: (a -> b) -> String -> Char -> IO Addr
-primCreateAdjThunk fun typestr callconv
+hugsprimCreateAdjThunk :: (a -> b) -> String -> Char -> IO Addr
+hugsprimCreateAdjThunk fun typestr callconv
    = do sp <- makeStablePtr fun
         p  <- copy_String_to_cstring typestr  -- is never freed
         a  <- primCreateAdjThunkARCH sp p callconv
         return a
 
 -- The following primitives are only needed if (n+k) patterns are enabled:
-primPmSub           :: Integral a => Int -> a -> a
-primPmSub n x        = x - fromInt n
+hugsprimPmSub           :: Integral a => Int -> a -> a
+hugsprimPmSub n x        = x - fromInt n
 
-primPmFromInteger   :: Integral a => Integer -> a
-primPmFromInteger    = fromIntegral
+hugsprimPmFromInteger   :: Integral a => Integer -> a
+hugsprimPmFromInteger    = fromIntegral
 
-primPmSubtract      :: Integral a => a -> a -> a
-primPmSubtract x y   = x - y
+hugsprimPmSubtract      :: Integral a => a -> a -> a
+hugsprimPmSubtract x y   = x - y
 
-primPmLe            :: Integral a => a -> a -> Bool
-primPmLe x y         = x <= y
+hugsprimPmLe            :: Integral a => a -> a -> Bool
+hugsprimPmLe x y         = x <= y
 
 -- Unpack strings generated by the Hugs code generator.
 -- Strings can contain \0 provided they're coded right.
@@ -1842,8 +1842,8 @@ prelCleanupAfterRunAction :: IORef (Maybe (IO ()))
 prelCleanupAfterRunAction = primRunST (newIORef Nothing)
 
 -- used when Hugs invokes top level function
-primRunIO_hugs_toplevel :: IO a -> ()
-primRunIO_hugs_toplevel m
+hugsprimRunIO_toplevel :: IO a -> ()
+hugsprimRunIO_toplevel m
    = protect 5 (fst (unST composite_action realWorld))
      where
         composite_action