2 % (c) The AQUA Project, Glasgow University, 1997
4 \section[MutableArray]{The @MutableArray@ interface}
6 Mutable (byte)arrays interface, re-exports type types and operations
7 over them from @ArrBase@. Have to be used in conjunction with
13 MutableArray(..), -- not abstract
20 newArray, -- :: Ix ix => (ix,ix) -> elt -> ST s (MutableArray s ix elt)
26 newStablePtrArray, -- :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
28 boundsOfArray, -- :: Ix ix => MutableArray s ix elt -> (ix, ix)
29 boundsOfMutableByteArray, -- :: Ix ix => MutableByteArray s ix -> (ix, ix)
31 readArray, -- :: Ix ix => MutableArray s ix elt -> ix -> ST s elt
33 readCharArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Char
34 readIntArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
35 readAddrArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr
36 readFloatArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
37 readDoubleArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
38 readStablePtrArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s (StablePtr a)
40 writeArray, -- :: Ix ix => MutableArray s ix elt -> ix -> elt -> ST s ()
41 writeCharArray, -- :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s ()
42 writeIntArray, -- :: Ix ix => MutableByteArray s ix -> ix -> Int -> ST s ()
43 writeAddrArray, -- :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s ()
44 writeFloatArray, -- :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s ()
45 writeDoubleArray, -- :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s ()
46 writeStablePtrArray, -- :: Ix ix => MutableByteArray s ix -> ix -> StablePtr a -> ST s ()
48 freezeArray, -- :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
49 freezeCharArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
50 freezeIntArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
51 freezeAddrArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
52 freezeFloatArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
53 freezeDoubleArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
54 freezeStablePtrArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
56 unsafeFreezeArray, -- :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
57 unsafeFreezeByteArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
58 thawArray, -- :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
60 -- the sizes are reported back are *in bytes*.
61 sizeofMutableByteArray, -- :: Ix ix => MutableByteArray s ix -> Int
63 readWord8Array, -- :: Ix ix => MutableByteArray s ix -> Int -> IO Word8
64 readWord16Array, -- :: Ix ix => MutableByteArray s ix -> Int -> IO Word16
65 readWord32Array, -- :: Ix ix => MutableByteArray s ix -> Int -> IO Word32
66 readWord64Array, -- :: Ix ix => MutableByteArray s ix -> Int -> IO Word64
68 writeWord8Array, -- :: Ix ix => MutableByteArray s ix -> Int -> Word8 -> IO ()
69 writeWord16Array, -- :: Ix ix => MutableByteArray s ix -> Int -> Word16 -> IO ()
70 writeWord32Array, -- :: Ix ix => MutableByteArray s ix -> Int -> Word32 -> IO ()
71 writeWord64Array, -- :: Ix ix => MutableByteArray s ix -> Int -> Word64 -> IO ()
73 readInt8Array, -- :: Ix ix => MutableByteArray s ix -> Int -> IO Int8
74 readInt16Array, -- :: Ix ix => MutableByteArray s ix -> Int -> IO Int16
75 readInt32Array, -- :: Ix ix => MutableByteArray s ix -> Int -> IO Int32
76 readInt64Array, -- :: Ix ix => MutableByteArray s ix -> Int -> IO Int64
78 writeInt8Array, -- :: Ix ix => MutableByteArray s ix -> Int -> Int8 -> IO ()
79 writeInt16Array, -- :: Ix ix => MutableByteArray s ix -> Int -> Int16 -> IO ()
80 writeInt32Array, -- :: Ix ix => MutableByteArray s ix -> Int -> Int32 -> IO ()
81 writeInt64Array -- :: Ix ix => MutableByteArray s ix -> Int -> Int64 -> IO ()
100 Note: the absence of operations to read/write ForeignObjs to a mutable
101 array is not accidental; storing foreign objs in a mutable array is
105 sizeofMutableByteArray :: Ix ix => MutableByteArray s ix -> Int
106 sizeofMutableByteArray (MutableByteArray _ arr#) =
107 case (sizeofMutableByteArray# arr#) of
113 newStablePtrArray :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
114 newStablePtrArray ixs = ST $ \ s# ->
115 case rangeSize ixs of { I# n# ->
116 case (newStablePtrArray# n# s#) of { (# s2#, barr# #) ->
117 (# s2#, (MutableByteArray ixs barr#) #) }}
119 readStablePtrArray :: Ix ix => MutableByteArray s ix -> ix -> ST s (StablePtr a)
120 readStablePtrArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
121 case (index ixs n) of { I# n# ->
122 case readStablePtrArray# barr# n# s# of { (# s2#, r# #) ->
123 (# s2# , (StablePtr r#) #) }}
125 writeStablePtrArray :: Ix ix => MutableByteArray s ix -> ix -> StablePtr a -> ST s ()
126 writeStablePtrArray (MutableByteArray ixs barr#) n (StablePtr sp#) = ST $ \ s# ->
127 case (index ixs n) of { I# n# ->
128 case writeStablePtrArray# barr# n# sp# s# of { s2# ->
131 freezeStablePtrArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
132 freezeStablePtrArray (MutableByteArray ixs arr#) = ST $ \ s# ->
133 case rangeSize ixs of { I# n# ->
134 case freeze arr# n# s# of { (# s2# , frozen# #) ->
135 (# s2# , ByteArray ixs frozen# #) }}
137 freeze :: MutableByteArray# s -- the thing
138 -> Int# -- size of thing to be frozen
139 -> State# s -- the Universe and everything
140 -> (# State# s, ByteArray# #)
143 = case (newStablePtrArray# n# s#) of { (# s2# , newarr1# #) ->
144 case copy 0# n# arr1# newarr1# s2# of { (# s3# , newarr2# #) ->
145 unsafeFreezeByteArray# newarr2# s3#
149 -> MutableByteArray# s -> MutableByteArray# s
151 -> (# State# s , MutableByteArray# s #)
153 copy cur# end# from# to# st#
157 = case (readStablePtrArray# from# cur# st#) of { (# s1# , ele #) ->
158 case (writeStablePtrArray# to# cur# ele s1#) of { s2# ->
159 copy (cur# +# 1#) end# from# to# s2#
165 Reminder: indexing an array at some base type is done in units
166 of the size of the type being; *not* in bytes.
169 readWord8Array :: MutableByteArray RealWorld Int -> Int -> IO Word8
170 readWord16Array :: MutableByteArray RealWorld Int -> Int -> IO Word16
171 readWord32Array :: MutableByteArray RealWorld Int -> Int -> IO Word32
172 readWord64Array :: MutableByteArray RealWorld Int -> Int -> IO Word64
174 readWord8Array (MutableByteArray ixs arr#) n@(I# n#) =
175 case sizeofMutableByteArray# arr# of
177 | n# ># (bytes# -# 1#) -> ioError (userError ("readWord8Array: index out of bounds "++show n))
178 | otherwise -> IO $ \ s# ->
179 case readCharArray# arr# n# s# of
180 (# s2# , r# #) -> (# s2# , intToWord8 (I# (ord# r#)) #)
182 readWord16Array (MutableByteArray ixs arr#) n@(I# n#) =
183 case sizeofMutableByteArray# arr# of
185 | n# ># (bytes# `quotInt#` 2# -# 1#) -> ioError (userError ("readWord16Array: index out of bounds "++show n))
186 | otherwise -> IO $ \ s# ->
187 case readWordArray# arr# (n# `quotInt#` 2#) s# of
189 case n# `remInt#` 2# of
190 0# -> (# s2# , wordToWord16 (W# w#) #) -- the double byte hides in the lower half of the wrd.
191 1# -> (# s2# , wordToWord16 (W# (shiftRL# w# 16#)) #) -- take the upper 16 bits.
193 readWord32Array (MutableByteArray ixs arr#) n@(I# n#) =
194 case sizeofMutableByteArray# arr# of
196 | n# ># (bytes# `quotInt#` 4# -# 1#) -> ioError (userError ("readWord32Array: index out of bounds "++show n))
197 | otherwise -> IO $ \ s# ->
198 case readWordArray# arr# n# s# of
199 (# s2# , w# #) -> (# s2# , wordToWord32 (W# w#) #)
201 readWord64Array mb n = do
202 l <- readWord32Array mb (2*n)
203 h <- readWord32Array mb (2*n + 1)
204 #ifdef WORDS_BIGENDIAN
205 return ( word32ToWord64 h + word32ToWord64 l * word32ToWord64 (maxBound::Word32))
207 return ( word32ToWord64 l + word32ToWord64 h * word32ToWord64 (maxBound::Word32))
210 writeWord8Array :: MutableByteArray RealWorld Int -> Int -> Word8 -> IO ()
211 writeWord16Array :: MutableByteArray RealWorld Int -> Int -> Word16 -> IO ()
212 writeWord32Array :: MutableByteArray RealWorld Int -> Int -> Word32 -> IO ()
213 writeWord64Array :: MutableByteArray RealWorld Int -> Int -> Word64 -> IO ()
215 writeWord8Array (MutableByteArray ixs arr#) n@(I# n#) w =
216 case sizeofMutableByteArray# arr# of
218 | n# ># (bytes# -# 1#) -> ioError (userError ("writeWord8Array: index out of bounds "++show n))
219 | otherwise -> IO $ \ s# ->
220 case writeCharArray# arr# n# (chr# (word2Int# (word8ToWord# w))) s# of
221 s2# -> (# s2# , () #)
223 writeWord16Array (MutableByteArray ixs arr#) n@(I# n#) w =
224 case sizeofMutableByteArray# arr# of
226 | n# ># (bytes# `quotInt#` 2# -# 1#) -> ioError (userError ("writeWord16Array: index out of bounds "++show n))
227 | otherwise -> IO $ \ s# ->
228 case readWordArray# arr# (n# `quotInt#` 2#) s# of
230 case writeWordArray# arr# (n# `quotInt#` 2#) (w# `or#` (v# `and#` mask )) s2# of
231 s3# -> (# s3# , () #)
234 let w' = word16ToWord# w in
235 case n# `remInt#` 2# of
240 case n# `remInt#` 2# of
241 0# -> case ``0xffff0000'' of W# x -> x -- writing to the lower half of the word.
242 1# -> int2Word# 0x0000ffff#
244 writeWord32Array (MutableByteArray ixs arr#) n@(I# n#) w =
245 case sizeofMutableByteArray# arr# of
247 | n# ># (bytes# `quotInt#` 4# -# 1#) -> ioError (userError ("writeWord32Array: index out of bounds "++show n))
248 | otherwise -> IO $ \ s# ->
249 case writeWordArray# arr# n# w# s# of
250 s2# -> (# s2# , () #)
254 writeWord64Array mb n w = do
255 #ifdef WORDS_BIGENDIAN
256 writeWord32Array mb (n*2) h
257 writeWord32Array mb (n*2+1) l
259 writeWord32Array mb (n*2) l
260 writeWord32Array mb (n*2+1) h
263 h = word64ToWord32 h'
264 l = word64ToWord32 l'
265 (h',l') = w `divMod` (word32ToWord64 (maxBound::Word32) + 1)
271 readInt8Array :: MutableByteArray RealWorld Int -> Int -> IO Int8
272 readInt16Array :: MutableByteArray RealWorld Int -> Int -> IO Int16
273 readInt32Array :: MutableByteArray RealWorld Int -> Int -> IO Int32
274 readInt64Array :: MutableByteArray RealWorld Int -> Int -> IO Int64
276 readInt8Array (MutableByteArray ixs arr#) n@(I# n#) =
277 case sizeofMutableByteArray# arr# of
279 | n# ># (bytes# -# 1#) -> ioError (userError ("readInt8Array: index out of bounds "++show n))
280 | otherwise -> IO $ \ s# ->
281 case readCharArray# arr# n# s# of
282 (# s2# , r# #) -> (# s2# , intToInt8 (I# (ord# r#)) #)
284 readInt16Array (MutableByteArray ixs arr#) n@(I# n#) =
285 case sizeofMutableByteArray# arr# of
287 | n# ># (bytes# `quotInt#` 2# -# 1#) -> ioError (userError ("readInt16Array: index out of bounds "++show n))
288 | otherwise -> IO $ \ s# ->
289 case readIntArray# arr# (n# `quotInt#` 2#) s# of
291 case n# `remInt#` 2# of
292 0# -> (# s2# , intToInt16 (I# i#) #)
293 1# -> (# s2# , intToInt16 (I# i#) #) -- FIXME.
295 readInt32Array (MutableByteArray ixs arr#) n@(I# n#) =
296 case sizeofMutableByteArray# arr# of
298 | n# ># (bytes# `quotInt#` 4# -# 1#) -> ioError (userError ("readInt32Array: index out of bounds "++show n))
299 | otherwise -> IO $ \ s# ->
300 case readIntArray# arr# n# s# of
301 (# s2# , i# #) -> (# s2# , intToInt32 (I# i#) #)
303 readInt64Array mb n = do
304 l <- readInt32Array mb (2*n)
305 h <- readInt32Array mb (2*n + 1)
306 #ifdef WORDS_BIGENDIAN
307 return ( int32ToInt64 h + int32ToInt64 l * int32ToInt64 (maxBound::Int32))
309 return ( int32ToInt64 l + int32ToInt64 h * int32ToInt64 (maxBound::Int32))
312 writeInt8Array :: MutableByteArray RealWorld Int -> Int -> Int8 -> IO ()
313 writeInt16Array :: MutableByteArray RealWorld Int -> Int -> Int16 -> IO ()
314 writeInt32Array :: MutableByteArray RealWorld Int -> Int -> Int32 -> IO ()
315 writeInt64Array :: MutableByteArray RealWorld Int -> Int -> Int64 -> IO ()
317 writeInt8Array (MutableByteArray ixs arr#) n@(I# n#) i =
318 case sizeofMutableByteArray# arr# of
320 | n# ># (bytes# -# 1#) -> ioError (userError ("writeInt8Array: index out of bounds "++show n))
321 | otherwise -> IO $ \ s# ->
322 case writeCharArray# arr# n# ch s# of
323 s2# -> (# s2# , () #)
325 ch = chr# (int8ToInt# i)
327 writeInt16Array (MutableByteArray ixs arr#) n@(I# n#) i =
328 case sizeofMutableByteArray# arr# of
330 | n# ># (bytes# `quotInt#` 2# -# 1#) -> ioError (userError ("writeInt16Array: index out of bounds "++show n))
331 | otherwise -> IO $ \ s# ->
332 case readIntArray# arr# (n# `quotInt#` 2#) s# of
334 let w' = word2Int# (int2Word# i# `or#` (int2Word# v# `and#` mask))
336 case writeIntArray# arr# (n# `quotInt#` 2#) w' s# of
337 s2# -> (# s2# , () #)
340 let i' = int16ToInt# i in
341 case n# `remInt#` 2# of
343 1# -> iShiftL# i' 16#
346 case n# `remInt#` 2# of
347 0# -> case ``0xffff0000'' of W# x -> x -- writing to the lower half of the word.
348 1# -> int2Word# 0x0000ffff#
350 writeInt32Array (MutableByteArray ixs arr#) n@(I# n#) i =
351 case sizeofMutableByteArray# arr# of
353 | n# ># (bytes# `quotInt#` 4# -# 1#) -> ioError (userError ("writeInt32Array: index out of bounds "++show n))
354 | otherwise -> IO $ \ s# ->
355 case writeIntArray# arr# n# i# s# of
356 s2# -> (# s2# , () #)
360 writeInt64Array mb n w = do
361 #ifdef WORDS_BIGENDIAN
362 writeInt32Array mb (n*2) h
363 writeInt32Array mb (n*2+1) l
365 writeInt32Array mb (n*2) l
366 writeInt32Array mb (n*2+1) h
371 (h',l') = w `divMod` (int32ToInt64 (maxBound::Int32) * 2 - 1)
376 {-# SPECIALIZE boundsOfMutableByteArray :: MutableByteArray s Int -> IPr #-}
377 boundsOfMutableByteArray :: Ix ix => MutableByteArray s ix -> (ix, ix)
378 boundsOfMutableByteArray (MutableByteArray ixs _) = ixs