From: sof <unknown>
Date: Mon, 29 Jun 1998 17:11:20 +0000 (+0000)
Subject: [project @ 1998-06-29 17:11:19 by sof]
X-Git-Tag: Approx_2487_patches~547
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=1bf84de723d41a6d0f0c6e1b48f594d29d2ba447;p=ghc-hetmet.git

[project @ 1998-06-29 17:11:19 by sof]
Added {read,write}Word{8,16,32}Array functions + sizeof(Mutable)?ByteArray
---

diff --git a/ghc/lib/exts/ByteArray.lhs b/ghc/lib/exts/ByteArray.lhs
index d74c728..f7db467 100644
--- a/ghc/lib/exts/ByteArray.lhs
+++ b/ghc/lib/exts/ByteArray.lhs
@@ -15,26 +15,14 @@ module ByteArray
         --Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
         indexCharArray,     --:: Ix ix => ByteArray ix -> ix -> Char 
         indexIntArray,      --:: Ix ix => ByteArray ix -> ix -> Int
+        indexWordArray,     --:: Ix ix => ByteArray ix -> ix -> Word
         indexAddrArray,     --:: Ix ix => ByteArray ix -> ix -> Addr
         indexFloatArray,    --:: Ix ix => ByteArray ix -> ix -> Float
         indexDoubleArray,   --:: Ix ix => ByteArray ix -> ix -> Double
-        
-        --Indexing off @Addrs@ is similar, and therefore given here.
-        indexCharOffAddr,   --:: Addr -> Int -> Char
-        indexIntOffAddr,    --:: Addr -> Int -> Int
-        indexAddrOffAddr,   --:: Addr -> Int -> Addr
-        indexFloatOffAddr,  --:: Addr -> Int -> Float
-        indexDoubleOffAddr, --:: Addr -> Int -> Double
-
-        Addr,
-	Word
 
        ) where
 
 import PrelArr
 import Ix
-import Foreign (Word)
-import Addr
-
 \end{code}
 
diff --git a/ghc/lib/exts/MutableArray.lhs b/ghc/lib/exts/MutableArray.lhs
index 7a45059..35fbe7d 100644
--- a/ghc/lib/exts/MutableArray.lhs
+++ b/ghc/lib/exts/MutableArray.lhs
@@ -51,12 +51,68 @@ module MutableArray
 
     unsafeFreezeArray,     -- :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)  
     unsafeFreezeByteArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-    thawArray              -- :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
+    thawArray,             -- :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
 
+     -- the sizes are reported back are *in bytes*.
+    sizeofByteArray,	    -- :: Ix ix => ByteArray ix -> Int
+    sizeofMutableByteArray, -- :: Ix ix => MutableByteArray s ix -> Int
+
+{-
+    readWord8Array,	    -- :: Ix ix => MutableByteArray s ix -> Word8
+    readWord16Array,	    -- :: Ix ix => MutableByteArray s ix -> Word16
+    readWord32Array,	    -- :: Ix ix => MutableByteArray s ix -> Word32
+-}
     ) where
 
 import PrelArr
+import PrelBase (sizeofMutableByteArray#, sizeofByteArray#, Int(..) )
 import ST
 import Ix
 
 \end{code}
+
+\begin{code}
+sizeofByteArray :: Ix ix => ByteArray ix -> Int
+sizeofByteArray (ByteArray _ arr#) = 
+  case (sizeofByteArray# arr#) of
+    i# -> (I# i#)
+
+sizeofMutableByteArray :: Ix ix => MutableByteArray s ix -> Int
+sizeofMutableByteArray (MutableByteArray _ arr#) = 
+  case (sizeofMutableByteArray# arr#) of
+    i# -> (I# i#)
+
+\end{code}
+
+begin{code}
+readWord8Array  :: Ix ix => MutableByteArray RealWorld ix -> ix -> IO Word8
+readWord16Array :: Ix ix => MutableByteArray RealWorld ix -> ix -> IO Word16
+readWord32Array :: Ix ix => MutableByteArray RealWorld ix -> ix -> IO Word32
+
+{- NB!!: The index for an array is in units of the element type being read -}
+
+readWord8Array (MutableByteArray ixs arr#) n@(I# n#) =
+    case sizeofMutableByteArray# arr#   of 
+      I# bytes# 
+       | n# ># (bytes# -# 1#) -> fail (userError "readWord8Array: index out of bounds "++show n)
+       | otherwise            -> IO $ \ s# ->
+         case readCharArray# barr# n# s#  of 
+           StateAndChar# s2# r# -> IOok s2# (W8# (int2Word# (ord# r#)))
+
+readWord16Array (MutableByteArray ixs arr#) n@(I# n#) =
+    case sizeofMutableByteArray# arr#   of 
+      I# bytes# 
+       | (2# *# n#) ># (bytes# -# 1#) -> fail (userError "readWord16Array: index out of bounds "++show n)
+       | otherwise                    -> IO $ \ s# ->
+         case readWordArray# barr# n# s#  of 
+           StateAndInt# s2# w# -> IOok s2# (wordToWord16 (W# w#))
+
+readWord32Array (MutableByteArray ixs arr#) n@(I# n#) =
+    case sizeofMutableByteArray# arr#   of 
+      I# bytes# 
+       | (4# *# n#) ># (bytes# -# 1#) -> fail (userError "readWord32Array: index out of bounds "++show n)
+       | otherwise                    -> IO $ \ s# ->
+         case readWordArray# barr# n# s#  of 
+           StateAndInt# s2# w# -> IOok s2# (wordToWord32 (W# w#))
+
+end{code}