Commit 94ab5da3 authored by sewardj's avatar sewardj
Browse files

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

Make hugsprimUnpackString :: Addr -> String available to Hugs' desugarer
in both modes.
parent 5ec16c8d
......@@ -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
......
......@@ -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");
......
......@@ -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
......
......@@ -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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment