Make hugsprimUnpackString :: Addr -> String available to Hugs' desugarer
in both modes.
primCompAux :: Ord a => a -> a -> Ordering -> Ordering
primCompAux x y o = case compare x y of EQ -> o; LT -> LT; GT -> GT
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
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
-- ToDo: make the message more informative.
primPmFail :: a
--
-- ToDo: change this (and Hugs code generator) to use ByteArrays
--
-- 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
where
-- The following decoding is based on evalString in the old machine.c
unpack i
* included in the distribution.
*
* $RCSfile: link.c,v $
* 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"
* ------------------------------------------------------------------------*/
#include "prelude.h"
= mkCPtr(lookupOTabName(modulePrelBase, "PrelBase_ZMZN_static_closure"));
name(nameCons).stgVar
= mkCPtr(lookupOTabName(modulePrelBase, "PrelBase_ZC_closure"));
= mkCPtr(lookupOTabName(modulePrelBase, "PrelBase_ZMZN_static_closure"));
name(nameCons).stgVar
= mkCPtr(lookupOTabName(modulePrelBase, "PrelBase_ZC_closure"));
+ nameUnpackString = linkName("hugsprimUnpackString");
/* implementTagToCon */
pFun(namePMFail, "primPmFail");
pFun(nameError, "error");
/* implementTagToCon */
pFun(namePMFail, "primPmFail");
pFun(nameError, "error");
- pFun(nameUnpackString, "primUnpackString");
+ pFun(nameUnpackString, "hugsprimUnpackString");
/* hooks for handwritten bytecode */
pFun(namePrimSeq, "primSeq");
/* hooks for handwritten bytecode */
pFun(namePrimSeq, "primSeq");
primCompAux :: Ord a => a -> a -> Ordering -> Ordering
primCompAux x y o = case compare x y of EQ -> o; LT -> LT; GT -> GT
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
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
-- ToDo: make the message more informative.
primPmFail :: a
--
-- ToDo: change this (and Hugs code generator) to use ByteArrays
--
-- 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
where
-- The following decoding is based on evalString in the old machine.c
unpack i
hugsprimEqChar,
fromDouble,
hugsprimMkIO,
hugsprimEqChar,
fromDouble,
hugsprimMkIO,
+ hugsprimCreateAdjThunk,
+ hugsprimUnpackString
import PrelNum
import PrelReal(Integral)
import Prelude(fromIntegral)
import PrelNum
import PrelReal(Integral)
import Prelude(fromIntegral)
+import IO(putStr,hFlush,stdout,stderr)
import PrelException(catch)
import PrelIOBase(IO,unsafePerformIO)
import PrelShow(show)
import PrelException(catch)
import PrelIOBase(IO,unsafePerformIO)
import PrelShow(show)
import PrelReal(Fractional,fromRational,toRational)
import PrelAddr(Addr)
import PrelErr(error)
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
-- Stuff needed by Hugs for desugaring. Do not mess with these!
-- They need to correspond exactly to versions written in
hugsprimPmLe :: Integral a => a -> a -> Bool
hugsprimPmLe 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 -> ()
-- used when Hugs invokes top level function
{-
hugsprimRunIO_toplevel :: IO a -> ()
hugsprimRunIO_toplevel :: IO a -> ()
hugsprimRunIO_toplevel m
= unsafePerformIO (
hugsprimRunIO_toplevel :: IO a -> ()
hugsprimRunIO_toplevel m
= unsafePerformIO (
+ catch (m >> hFlush stderr >> hFlush stdout)
(\e -> putStr (show e ++ "\n"))
)
(\e -> putStr (show e ++ "\n"))
)
\end{code}
\ No newline at end of file
\end{code}
\ No newline at end of file