Commit 5b4a7c8d authored by andy's avatar andy
Browse files

[project @ 1999-11-04 00:32:30 by andy]

Modifing these libs so that they also work with StgHugs.
parent 5c05f30b
...@@ -23,14 +23,12 @@ module Addr ...@@ -23,14 +23,12 @@ module Addr
) where ) where
#ifdef __HUGS__ import NumExts
import PreludeBuiltin #ifndef __HUGS__
#else
import PrelAddr import PrelAddr
import PrelForeign import PrelForeign
import PrelStable import PrelStable
import PrelBase import PrelBase
import NumExts
import PrelIOBase ( IO(..) ) import PrelIOBase ( IO(..) )
import Word ( indexWord8OffAddr, indexWord16OffAddr import Word ( indexWord8OffAddr, indexWord16OffAddr
, indexWord32OffAddr, indexWord64OffAddr , indexWord32OffAddr, indexWord64OffAddr
...@@ -52,6 +50,16 @@ import Int ( indexInt8OffAddr, indexInt16OffAddr ...@@ -52,6 +50,16 @@ import Int ( indexInt8OffAddr, indexInt16OffAddr
\end{code} \end{code}
\begin{code} \begin{code}
#ifdef __HUGS__
instance Show Addr where
showsPrec p addr rs = pad_out (showHex int "") rs
where
-- want 0s prefixed to pad it out to a fixed length.
pad_out ('0':'x':ls) rs =
'0':'x':(replicate (2*ADDR_SIZE_IN_BYTES - length ls) '0')
++ ls ++ rs
int = primAddrToInt addr
#else
instance Show Addr where instance Show Addr where
showsPrec p (A# a) rs = pad_out (showHex int "") rs showsPrec p (A# a) rs = pad_out (showHex int "") rs
where where
...@@ -62,7 +70,7 @@ instance Show Addr where ...@@ -62,7 +70,7 @@ instance Show Addr where
int = int =
case word2Integer# (int2Word# (addr2Int# a)) of case word2Integer# (int2Word# (addr2Int# a)) of
(# s, d #) -> J# s d (# s, d #) -> J# s d
#endif
\end{code} \end{code}
...@@ -93,12 +101,13 @@ indexDoubleOffAddr :: Addr -> Int -> Double ...@@ -93,12 +101,13 @@ indexDoubleOffAddr :: Addr -> Int -> Double
indexStablePtrOffAddr :: Addr -> Int -> StablePtr a indexStablePtrOffAddr :: Addr -> Int -> StablePtr a
#ifdef __HUGS__ #ifdef __HUGS__
indexCharOffAddr = primIndexCharOffAddr indexCharOffAddr = error "TODO: indexCharOffAddr "
indexIntOffAddr = primIndexIntOffAddr indexIntOffAddr = error "TODO: indexIntOffAddr "
indexWordOffAddr = primIndexWordOffAddr indexWordOffAddr = error "TODO: indexWordOffAddr "
indexAddrOffAddr = primIndexAddrOffAddr indexAddrOffAddr = error "TODO: indexAddrOffAddr "
indexFloatOffAddr = primIndexFloatOffAddr indexFloatOffAddr = error "TODO: indexFloatOffAddr "
indexDoubleOffAddr = primIndexDoubleOffAddr indexDoubleOffAddr = error "TODO: indexDoubleOffAddr"
indexStablePtrOffAddr = error "TODO: indexStablePtrOffAddr"
#else #else
indexCharOffAddr (A# addr#) n indexCharOffAddr (A# addr#) n
= case n of { I# n# -> = case n of { I# n# ->
...@@ -144,12 +153,13 @@ readDoubleOffAddr :: Addr -> Int -> IO Double ...@@ -144,12 +153,13 @@ readDoubleOffAddr :: Addr -> Int -> IO Double
readStablePtrOffAddr :: Addr -> Int -> IO (StablePtr a) readStablePtrOffAddr :: Addr -> Int -> IO (StablePtr a)
#ifdef __HUGS__ #ifdef __HUGS__
readCharOffAddr = primReadCharOffAddr readCharOffAddr = error "TODO: readCharOffAddr "
readIntOffAddr = primReadIntOffAddr readIntOffAddr = error "TODO: readIntOffAddr "
readWordOffAddr = primReadWordOffAddr readWordOffAddr = error "TODO: readWordOffAddr "
readAddrOffAddr = primReadAddrOffAddr readAddrOffAddr = error "TODO: readAddrOffAddr "
readFloatOffAddr = primReadFloatOffAddr readFloatOffAddr = error "TODO: readFloatOffAddr "
readDoubleOffAddr = primReadDoubleOffAddr readDoubleOffAddr = error "TODO: readDoubleOffAddr "
readStablePtrOffAddr = error "TODO: readStablePtrOffAddr"
#else #else
readCharOffAddr a i = case indexCharOffAddr a i of { C# o# -> return (C# o#) } readCharOffAddr a i = case indexCharOffAddr a i of { C# o# -> return (C# o#) }
readIntOffAddr a i = case indexIntOffAddr a i of { I# o# -> return (I# o#) } readIntOffAddr a i = case indexIntOffAddr a i of { I# o# -> return (I# o#) }
...@@ -171,12 +181,12 @@ writeFloatOffAddr :: Addr -> Int -> Float -> IO () ...@@ -171,12 +181,12 @@ writeFloatOffAddr :: Addr -> Int -> Float -> IO ()
writeDoubleOffAddr :: Addr -> Int -> Double -> IO () writeDoubleOffAddr :: Addr -> Int -> Double -> IO ()
#ifdef __HUGS__ #ifdef __HUGS__
writeCharOffAddr = primWriteCharOffAddr writeCharOffAddr = error "TODO: writeCharOffAddr "
writeIntOffAddr = primWriteIntOffAddr writeIntOffAddr = error "TODO: writeIntOffAddr "
writeWordOffAddr = primWriteWordOffAddr writeWordOffAddr = error "TODO: writeWordOffAddr "
writeAddrOffAddr = primWriteAddrOffAddr writeAddrOffAddr = error "TODO: writeAddrOffAddr "
writeFloatOffAddr = primWriteFloatOffAddr writeFloatOffAddr = error "TODO: writeFloatOffAddr "
writeDoubleOffAddr = primWriteDoubleOffAddr writeDoubleOffAddr = error "TODO: writeDoubleOffAddr "
#else #else
writeCharOffAddr (A# a#) (I# i#) (C# c#) = IO $ \ s# -> writeCharOffAddr (A# a#) (I# i#) (C# c#) = IO $ \ s# ->
case (writeCharOffAddr# a# i# c# s#) of s2# -> (# s2#, () #) case (writeCharOffAddr# a# i# c# s#) of s2# -> (# s2#, () #)
......
...@@ -28,7 +28,6 @@ module NumExts ...@@ -28,7 +28,6 @@ module NumExts
import Char (ord, chr) import Char (ord, chr)
#ifdef __HUGS__ #ifdef __HUGS__
import PreludeBuiltin
ord_0 = ord '0' ord_0 = ord '0'
#else #else
import PrelNum ( ord_0 ) import PrelNum ( ord_0 )
...@@ -106,4 +105,13 @@ from @NumExts@. ...@@ -106,4 +105,13 @@ from @NumExts@.
\begin{code} \begin{code}
showListWith :: (a -> ShowS) -> [a] -> ShowS showListWith :: (a -> ShowS) -> [a] -> ShowS
showListWith = showList__ showListWith = showList__
#ifdef __HUGS__
showList__ :: (a -> ShowS) -> [a] -> ShowS
showList__ _ [] s = "[]" ++ s
showList__ showx (x:xs) s = '[' : showx x (showl xs)
where
showl [] = ']' : s
showl (y:ys) = ',' : showx y (showl ys)
#endif
\end{code} \end{code}
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