From 94ab5da310e37097a08c9a5f56ad46ff74d1a475 Mon Sep 17 00:00:00 2001 From: sewardj Date: Wed, 12 Jan 2000 10:44:50 +0000 Subject: [PATCH] [project @ 2000-01-12 10:44:50 by sewardj] Make hugsprimUnpackString :: Addr -> String available to Hugs' desugarer in both modes. --- ghc/interpreter/lib/Prelude.hs | 11 +++++++---- ghc/interpreter/link.c | 7 ++++--- ghc/lib/hugs/Prelude.hs | 11 +++++++---- ghc/lib/std/PrelHugs.lhs | 13 ++++++++++--- 4 files changed, 28 insertions(+), 14 deletions(-) diff --git a/ghc/interpreter/lib/Prelude.hs b/ghc/interpreter/lib/Prelude.hs index ce05049..30bbcd7 100644 --- 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 --- 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 --- 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 --- 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 -- 1.7.10.4