[project @ 2000-01-12 10:44:50 by sewardj]

Make hugsprimUnpackString :: Addr -> String available to Hugs' desugarer
in both modes.

diff --git a/ghc/interpreter/lib/Prelude.hs b/ghc/interpreter/lib/Prelude.hs
index ce05049..30bbcd7 100644 (file)
--- a/ghc/interpreter/lib/Prelude.hs
+++ b/ghc/interpreter/lib/Prelude.hs
@@ -1548,14 +1548,17 @@ 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
 
+hugsprimEqChar       :: Char -> Char -> Bool
+hugsprimEqChar c1 c2  = primEqChar c1 c2
+
 hugsprimPmInt        :: Num a => Int -> a -> Bool
 hugsprimPmInt n x     = fromInt 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
+hugsprimPmDouble     :: Fractional a => Double -> a -> Bool
+hugsprimPmDouble n x  = fromDouble n == x
 
 -- ToDo: make the message more informative.
 primPmFail       :: a
@@ -1590,8 +1593,8 @@ hugsprimPmLe x y         = x <= y
 -- 
 -- ToDo: change this (and Hugs code generator) to use ByteArrays
 
-primUnpackString :: Addr -> String
-primUnpackString a = unpack 0
+hugsprimUnpackString :: Addr -> String
+hugsprimUnpackString a = unpack 0
  where
   -- The following decoding is based on evalString in the old machine.c
   unpack i

diff --git a/ghc/interpreter/link.c b/ghc/interpreter/link.c
index ef5ba39..1fc2473 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.35 $
- * $Date: 2000/01/12 10:30:09 $
+ * $Revision: 1.36 $
+ * $Date: 2000/01/12 10:44:50 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -526,6 +526,7 @@ Int what; {
               = mkCPtr(lookupOTabName(modulePrelBase, "PrelBase_ZMZN_static_closure"));
            name(nameCons).stgVar 
               = mkCPtr(lookupOTabName(modulePrelBase, "PrelBase_ZC_closure"));
+           nameUnpackString = linkName("hugsprimUnpackString");
 #endif
 #endif
            break;
@@ -616,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");

diff --git a/ghc/lib/hugs/Prelude.hs b/ghc/lib/hugs/Prelude.hs
index ce05049..30bbcd7 100644 (file)
--- a/ghc/lib/hugs/Prelude.hs
+++ b/ghc/lib/hugs/Prelude.hs
@@ -1548,14 +1548,17 @@ 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
 
+hugsprimEqChar       :: Char -> Char -> Bool
+hugsprimEqChar c1 c2  = primEqChar c1 c2
+
 hugsprimPmInt        :: Num a => Int -> a -> Bool
 hugsprimPmInt n x     = fromInt 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
+hugsprimPmDouble     :: Fractional a => Double -> a -> Bool
+hugsprimPmDouble n x  = fromDouble n == x
 
 -- ToDo: make the message more informative.
 primPmFail       :: a
@@ -1590,8 +1593,8 @@ hugsprimPmLe x y         = x <= y
 -- 
 -- ToDo: change this (and Hugs code generator) to use ByteArrays
 
-primUnpackString :: Addr -> String
-primUnpackString a = unpack 0
+hugsprimUnpackString :: Addr -> String
+hugsprimUnpackString a = unpack 0
  where
   -- The following decoding is based on evalString in the old machine.c
   unpack i

diff --git a/ghc/lib/std/PrelHugs.lhs b/ghc/lib/std/PrelHugs.lhs
index 0165c75..b5d889b 100644 (file)
--- a/ghc/lib/std/PrelHugs.lhs
+++ b/ghc/lib/std/PrelHugs.lhs
@@ -17,7 +17,8 @@ module PrelHugs (
    hugsprimEqChar,
    fromDouble,
    hugsprimMkIO,
-   hugsprimCreateAdjThunk
+   hugsprimCreateAdjThunk,
+   hugsprimUnpackString
 )
 where
 import PrelGHC
@@ -25,7 +26,7 @@ import PrelBase
 import PrelNum
 import PrelReal(Integral)
 import Prelude(fromIntegral)
-import IO(putStr)
+import IO(putStr,hFlush,stdout,stderr)
 import PrelException(catch)
 import PrelIOBase(IO,unsafePerformIO)
 import PrelShow(show)
@@ -33,6 +34,7 @@ import PrelFloat(Double)
 import PrelReal(Fractional,fromRational,toRational)
 import PrelAddr(Addr)
 import PrelErr(error)
+import PrelPack(unpackCString)
 
 -- Stuff needed by Hugs for desugaring.  Do not mess with these!
 -- They need to correspond exactly to versions written in 
@@ -77,6 +79,10 @@ hugsprimPmSubtract x y   = x - y
 hugsprimPmLe            :: Integral a => a -> a -> Bool
 hugsprimPmLe x y         = x <= y
 
+hugsprimUnpackString :: Addr -> String
+hugsprimUnpackString a = unpackCString a
+
+
 -- used when Hugs invokes top level function
 {-
 hugsprimRunIO_toplevel :: IO a -> ()
@@ -102,8 +108,9 @@ hugsprimRunIO_toplevel m
 hugsprimRunIO_toplevel :: IO a -> ()
 hugsprimRunIO_toplevel m
    = unsafePerformIO (
-        catch (m >> return ())
+        catch (m >> hFlush stderr >> hFlush stdout)
               (\e -> putStr (show e ++ "\n"))
      )
 
+
 \end{code}
\ No newline at end of file