From 73a6331a738efead9f2465c9373a39b80799ffa3 Mon Sep 17 00:00:00 2001 From: sof Date: Mon, 29 Jun 1998 16:34:59 +0000 Subject: [PATCH] [project @ 1998-06-29 16:34:59 by sof] Added functions for creating/reading/writing mutable Word arrays --- ghc/lib/std/PrelArr.lhs | 87 ++++++++++++++++++++++++++++++----------------- 1 file changed, 55 insertions(+), 32 deletions(-) diff --git a/ghc/lib/std/PrelArr.lhs b/ghc/lib/std/PrelArr.lhs index b738b6e..88ae5b7 100644 --- a/ghc/lib/std/PrelArr.lhs +++ b/ghc/lib/std/PrelArr.lhs @@ -222,6 +222,7 @@ newCharArray, newIntArray, newAddrArray, newFloatArray, newDoubleArray #-} {-# SPECIALIZE newCharArray :: IPr -> ST s (MutableByteArray s Int) #-} {-# SPECIALIZE newIntArray :: IPr -> ST s (MutableByteArray s Int) #-} +{-# SPECIALIZE newWordArray :: IPr -> ST s (MutableByteArray s Int) #-} {-# SPECIALIZE newAddrArray :: IPr -> ST s (MutableByteArray s Int) #-} {-# SPECIALIZE newFloatArray :: IPr -> ST s (MutableByteArray s Int) #-} {-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-} @@ -241,6 +242,11 @@ newIntArray ixs = ST $ \ s# -> case (newIntArray# n# s#) of { StateAndMutableByteArray# s2# barr# -> STret s2# (MutableByteArray ixs barr#) }} +newWordArray ixs = ST $ \ s# -> + case rangeSize ixs of { I# n# -> + case (newWordArray# n# s#) of { StateAndMutableByteArray# s2# barr# -> + STret s2# (MutableByteArray ixs barr#) }} + newAddrArray ixs = ST $ \ s# -> case rangeSize ixs of { I# n# -> case (newAddrArray# n# s#) of { StateAndMutableByteArray# s2# barr# -> @@ -269,6 +275,7 @@ readArray :: Ix ix => MutableArray s ix elt -> ix -> ST s elt readCharArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Char readIntArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Int +readWordArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Word readAddrArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr readFloatArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Float readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double @@ -297,6 +304,11 @@ readIntArray (MutableByteArray ixs barr#) n = ST $ \ s# -> case readIntArray# barr# n# s# of { StateAndInt# s2# r# -> STret s2# (I# r#) }} +readWordArray (MutableByteArray ixs barr#) n = ST $ \ s# -> + case (index ixs n) of { I# n# -> + case readWordArray# barr# n# s# of { StateAndWord# s2# r# -> + STret s2# (W# r#) }} + readAddrArray (MutableByteArray ixs barr#) n = ST $ \ s# -> case (index ixs n) of { I# n# -> case readAddrArray# barr# n# s# of { StateAndAddr# s2# r# -> @@ -315,6 +327,7 @@ readDoubleArray (MutableByteArray ixs barr#) n = ST $ \ s# -> --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 @@ -335,6 +348,11 @@ indexIntArray (ByteArray ixs barr#) n case indexIntArray# barr# n# of { r# -> (I# r#)}} +indexWordArray (ByteArray ixs barr#) n + = case (index ixs n) of { I# n# -> + case indexWordArray# barr# n# of { r# -> + (W# r#)}} + indexAddrArray (ByteArray ixs barr#) n = case (index ixs n) of { I# n# -> case indexAddrArray# barr# n# of { r# -> @@ -350,41 +368,10 @@ indexDoubleArray (ByteArray ixs barr#) n case indexDoubleArray# barr# n# of { r# -> (D# r#)}} ---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 - -indexCharOffAddr (A# addr#) n - = case n of { I# n# -> - case indexCharOffAddr# addr# n# of { r# -> - (C# r#)}} - -indexIntOffAddr (A# addr#) n - = case n of { I# n# -> - case indexIntOffAddr# addr# n# of { r# -> - (I# r#)}} - -indexAddrOffAddr (A# addr#) n - = case n of { I# n# -> - case indexAddrOffAddr# addr# n# of { r# -> - (A# r#)}} - -indexFloatOffAddr (A# addr#) n - = case n of { I# n# -> - case indexFloatOffAddr# addr# n# of { r# -> - (F# r#)}} - -indexDoubleOffAddr (A# addr#) n - = case n of { I# n# -> - case indexDoubleOffAddr# addr# n# of { r# -> - (D# r#)}} - writeArray :: Ix ix => MutableArray s ix elt -> ix -> elt -> ST s () writeCharArray :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s () writeIntArray :: Ix ix => MutableByteArray s ix -> ix -> Int -> ST s () +writeWordArray :: Ix ix => MutableByteArray s ix -> ix -> Word -> ST s () writeAddrArray :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s () writeFloatArray :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s () writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s () @@ -413,6 +400,11 @@ writeIntArray (MutableByteArray ixs barr#) n (I# ele) = ST $ \ s# -> case writeIntArray# barr# n# ele s# of { s2# -> STret s2# () }} +writeWordArray (MutableByteArray ixs barr#) n (W# ele) = ST $ \ s# -> + case (index ixs n) of { I# n# -> + case writeWordArray# barr# n# ele s# of { s2# -> + STret s2# () }} + writeAddrArray (MutableByteArray ixs barr#) n (A# ele) = ST $ \ s# -> case (index ixs n) of { I# n# -> case writeAddrArray# barr# n# ele s# of { s2# -> @@ -440,6 +432,7 @@ writeDoubleArray (MutableByteArray ixs barr#) n (D# ele) = ST $ \ s# -> freezeArray :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt) freezeCharArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix) freezeIntArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix) +freezeWordArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix) freezeAddrArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix) freezeFloatArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix) freezeDoubleArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix) @@ -541,6 +534,36 @@ freezeIntArray (MutableByteArray ixs arr#) = ST $ \ s# -> copy (cur# +# 1#) end# from# to# s2# }} +freezeWordArray (MutableByteArray ixs arr#) = ST $ \ s# -> + case rangeSize ixs of { I# n# -> + case freeze arr# n# s# of { StateAndByteArray# s2# frozen# -> + STret s2# (ByteArray ixs frozen#) }} + where + freeze :: MutableByteArray# s -- the thing + -> Int# -- size of thing to be frozen + -> State# s -- the Universe and everything + -> StateAndByteArray# s + + freeze arr# n# s# + = case (newWordArray# n# s#) of { StateAndMutableByteArray# s2# newarr1# -> + case copy 0# n# arr# newarr1# s2# of { StateAndMutableByteArray# s3# newarr2# -> + unsafeFreezeByteArray# newarr2# s3# + }} + where + copy :: Int# -> Int# + -> MutableByteArray# s -> MutableByteArray# s + -> State# s + -> StateAndMutableByteArray# s + + copy cur# end# from# to# s# + | cur# ==# end# + = StateAndMutableByteArray# s# to# + | otherwise + = case (readWordArray# from# cur# s#) of { StateAndWord# s1# ele -> + case (writeWordArray# to# cur# ele s1#) of { s2# -> + copy (cur# +# 1#) end# from# to# s2# + }} + freezeAddrArray (MutableByteArray ixs arr#) = ST $ \ s# -> case rangeSize ixs of { I# n# -> case freeze arr# n# s# of { StateAndByteArray# s2# frozen# -> -- 1.7.10.4