1 {-# OPTIONS -monly-3-regs #-}
2 -----------------------------------------------------------------------------
4 -- Module : Data.Array.Base
5 -- Copyright : (c) The University of Glasgow 2001
6 -- License : BSD-style (see the file libraries/core/LICENSE)
8 -- Maintainer : libraries@haskell.org
9 -- Stability : experimental
10 -- Portability : non-portable
12 -- $Id: Base.hs,v 1.3 2001/07/31 13:38:10 simonmar Exp $
14 -- Basis for IArray and MArray. Not intended for external consumption;
15 -- use IArray or MArray instead.
17 -----------------------------------------------------------------------------
19 module Data.Array.Base where
23 import Data.Ix ( Ix, range, index, rangeSize )
25 #ifdef __GLASGOW_HASKELL__
26 import GHC.Arr ( STArray, unsafeIndex )
27 import qualified GHC.Arr
28 import GHC.ST ( ST(..), runST )
30 import GHC.Word ( Word(..) )
31 import GHC.Ptr ( Ptr(..), FunPtr(..) )
32 import GHC.Float ( Float(..), Double(..) )
33 import GHC.Stable ( StablePtr(..) )
34 import GHC.Int ( Int8(..), Int16(..), Int32(..), Int64(..) )
35 import GHC.Word ( Word8(..), Word16(..), Word32(..), Word64(..) )
41 -----------------------------------------------------------------------------
42 -- Class of immutable arrays
44 class HasBounds a where
45 bounds :: Ix i => a i e -> (i,i)
47 class HasBounds a => IArray a e where
48 unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> a i e
49 unsafeAt :: Ix i => a i e -> Int -> e
50 unsafeReplace :: Ix i => a i e -> [(Int, e)] -> a i e
51 unsafeAccum :: Ix i => (e -> e' -> e) -> a i e -> [(Int, e')] -> a i e
52 unsafeAccumArray :: Ix i => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> a i e
54 unsafeReplace arr ies = runST (unsafeReplaceST arr ies >>= unsafeFreeze)
55 unsafeAccum f arr ies = runST (unsafeAccumST f arr ies >>= unsafeFreeze)
56 unsafeAccumArray f e lu ies = runST (unsafeAccumArrayST f e lu ies >>= unsafeFreeze)
58 {-# INLINE unsafeReplaceST #-}
59 unsafeReplaceST :: (IArray a e, Ix i) => a i e -> [(Int, e)] -> ST s (STArray s i e)
60 unsafeReplaceST arr ies = do
62 sequence_ [unsafeWrite marr i e | (i, e) <- ies]
65 {-# INLINE unsafeAccumST #-}
66 unsafeAccumST :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(Int, e')] -> ST s (STArray s i e)
67 unsafeAccumST f arr ies = do
70 old <- unsafeRead marr i
71 unsafeWrite marr i (f old new)
75 {-# INLINE unsafeAccumArrayST #-}
76 unsafeAccumArrayST :: Ix i => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (STArray s i e)
77 unsafeAccumArrayST f e (l,u) ies = do
78 marr <- newArray (l,u) e
80 old <- unsafeRead marr i
81 unsafeWrite marr i (f old new)
86 array :: (IArray a e, Ix i) => (i,i) -> [(i, e)] -> a i e
87 array (l,u) ies = unsafeArray (l,u) [(index (l,u) i, e) | (i, e) <- ies]
89 -- Since unsafeFreeze is not guaranteed to be only a cast, we will
90 -- use unsafeArray and zip instead of a specialized loop to implement
91 -- listArray, unlike Array.listArray, even though it generates some
92 -- unnecessary heap allocation. Will use the loop only when we have
93 -- fast unsafeFreeze, namely for Array and UArray (well, they cover
96 {-# INLINE listArray #-}
97 listArray :: (IArray a e, Ix i) => (i,i) -> [e] -> a i e
98 listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es)
100 {-# INLINE listArrayST #-}
101 listArrayST :: Ix i => (i,i) -> [e] -> ST s (STArray s i e)
102 listArrayST (l,u) es = do
103 marr <- newArray_ (l,u)
104 let n = rangeSize (l,u)
105 let fillFromList i xs | i == n = return ()
106 | otherwise = case xs of
108 y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys
113 "listArray/Array" listArray =
114 \lu es -> runST (listArrayST lu es >>= GHC.Arr.unsafeFreezeSTArray)
117 {-# INLINE listUArrayST #-}
118 listUArrayST :: (MArray (STUArray s) e (ST s), Ix i)
119 => (i,i) -> [e] -> ST s (STUArray s i e)
120 listUArrayST (l,u) es = do
121 marr <- newArray_ (l,u)
122 let n = rangeSize (l,u)
123 let fillFromList i xs | i == n = return ()
124 | otherwise = case xs of
126 y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys
130 -- I don't know how to write a single rule for listUArrayST, because
131 -- the type looks like constrained over 's', which runST doesn't
132 -- like. In fact all MArray (STUArray s) instances are polymorphic
133 -- wrt. 's', but runST can't know that.
135 -- I would like to write a rule for listUArrayST (or listArray or
136 -- whatever) applied to unpackCString#. Unfortunately unpackCString#
137 -- calls seem to be floated out, then floated back into the middle
138 -- of listUArrayST, so I was not able to do this.
141 "listArray/UArray/Bool" listArray = \lu (es :: [Bool]) ->
142 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
143 "listArray/UArray/Char" listArray = \lu (es :: [Char]) ->
144 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
145 "listArray/UArray/Int" listArray = \lu (es :: [Int]) ->
146 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
147 "listArray/UArray/Word" listArray = \lu (es :: [Word]) ->
148 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
149 "listArray/UArray/Ptr" listArray = \lu (es :: [Ptr a]) ->
150 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
151 "listArray/UArray/FunPtr" listArray = \lu (es :: [FunPtr a]) ->
152 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
153 "listArray/UArray/Float" listArray = \lu (es :: [Float]) ->
154 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
155 "listArray/UArray/Double" listArray = \lu (es :: [Double]) ->
156 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
157 "listArray/UArray/StablePtr" listArray = \lu (es :: [StablePtr a]) ->
158 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
159 "listArray/UArray/Int8" listArray = \lu (es :: [Int8]) ->
160 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
161 "listArray/UArray/Int16" listArray = \lu (es :: [Int16]) ->
162 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
163 "listArray/UArray/Int32" listArray = \lu (es :: [Int32]) ->
164 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
165 "listArray/UArray/Int64" listArray = \lu (es :: [Int64]) ->
166 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
167 "listArray/UArray/Word8" listArray = \lu (es :: [Word8]) ->
168 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
169 "listArray/UArray/Word16" listArray = \lu (es :: [Word16]) ->
170 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
171 "listArray/UArray/Word32" listArray = \lu (es :: [Word32]) ->
172 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
173 "listArray/UArray/Word64" listArray = \lu (es :: [Word64]) ->
174 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
178 (!) :: (IArray a e, Ix i) => a i e -> i -> e
179 arr ! i | (l,u) <- bounds arr = unsafeAt arr (index (l,u) i)
181 {-# INLINE indices #-}
182 indices :: (HasBounds a, Ix i) => a i e -> [i]
183 indices arr | (l,u) <- bounds arr = range (l,u)
186 elems :: (IArray a e, Ix i) => a i e -> [e]
187 elems arr | (l,u) <- bounds arr =
188 [unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]]
190 {-# INLINE assocs #-}
191 assocs :: (IArray a e, Ix i) => a i e -> [(i, e)]
192 assocs arr | (l,u) <- bounds arr =
193 [(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)]
195 {-# INLINE accumArray #-}
196 accumArray :: (IArray a e, Ix i) => (e -> e' -> e) -> e -> (i,i) -> [(i, e')] -> a i e
197 accumArray f init (l,u) ies =
198 unsafeAccumArray f init (l,u) [(index (l,u) i, e) | (i, e) <- ies]
201 (//) :: (IArray a e, Ix i) => a i e -> [(i, e)] -> a i e
202 arr // ies | (l,u) <- bounds arr =
203 unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies]
206 accum :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(i, e')] -> a i e
207 accum f arr ies | (l,u) <- bounds arr =
208 unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies]
211 amap :: (IArray a e', IArray a e, Ix i) => (e' -> e) -> a i e' -> a i e
212 amap f arr | (l,u) <- bounds arr =
213 unsafeArray (l,u) [(i, f (unsafeAt arr i)) | i <- [0 .. rangeSize (l,u) - 1]]
216 ixmap :: (IArray a e, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> a i e
218 unsafeArray (l,u) [(unsafeIndex (l,u) i, arr ! f i) | i <- range (l,u)]
220 -----------------------------------------------------------------------------
221 -- Normal polymorphic arrays
223 instance HasBounds GHC.Arr.Array where
224 {-# INLINE bounds #-}
225 bounds = GHC.Arr.bounds
227 instance IArray GHC.Arr.Array e where
228 {-# INLINE unsafeArray #-}
229 unsafeArray = GHC.Arr.unsafeArray
230 {-# INLINE unsafeAt #-}
231 unsafeAt = GHC.Arr.unsafeAt
232 {-# INLINE unsafeReplace #-}
233 unsafeReplace = GHC.Arr.unsafeReplace
234 {-# INLINE unsafeAccum #-}
235 unsafeAccum = GHC.Arr.unsafeAccum
236 {-# INLINE unsafeAccumArray #-}
237 unsafeAccumArray = GHC.Arr.unsafeAccumArray
239 -----------------------------------------------------------------------------
240 -- Flat unboxed arrays
242 data UArray i e = UArray !i !i ByteArray#
244 INSTANCE_TYPEABLE2(UArray,uArrayTc,"UArray")
246 instance HasBounds UArray where
247 {-# INLINE bounds #-}
248 bounds (UArray l u _) = (l,u)
250 {-# INLINE unsafeArrayUArray #-}
251 unsafeArrayUArray :: (MArray (STUArray s) e (ST s), Ix i)
252 => (i,i) -> [(Int, e)] -> ST s (UArray i e)
253 unsafeArrayUArray (l,u) ies = do
254 marr <- newArray_ (l,u)
255 sequence_ [unsafeWrite marr i e | (i, e) <- ies]
256 unsafeFreezeSTUArray marr
258 {-# INLINE unsafeFreezeSTUArray #-}
259 unsafeFreezeSTUArray :: STUArray s i e -> ST s (UArray i e)
260 unsafeFreezeSTUArray (STUArray l u marr#) = ST $ \s1# ->
261 case unsafeFreezeByteArray# marr# s1# of { (# s2#, arr# #) ->
262 (# s2#, UArray l u arr# #) }
264 {-# INLINE unsafeReplaceUArray #-}
265 unsafeReplaceUArray :: (MArray (STUArray s) e (ST s), Ix i)
266 => UArray i e -> [(Int, e)] -> ST s (UArray i e)
267 unsafeReplaceUArray arr ies = do
268 marr <- thawSTUArray arr
269 sequence_ [unsafeWrite marr i e | (i, e) <- ies]
270 unsafeFreezeSTUArray marr
272 {-# INLINE unsafeAccumUArray #-}
273 unsafeAccumUArray :: (MArray (STUArray s) e (ST s), Ix i)
274 => (e -> e' -> e) -> UArray i e -> [(Int, e')] -> ST s (UArray i e)
275 unsafeAccumUArray f arr ies = do
276 marr <- thawSTUArray arr
278 old <- unsafeRead marr i
279 unsafeWrite marr i (f old new)
281 unsafeFreezeSTUArray marr
283 {-# INLINE unsafeAccumArrayUArray #-}
284 unsafeAccumArrayUArray :: (MArray (STUArray s) e (ST s), Ix i)
285 => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (UArray i e)
286 unsafeAccumArrayUArray f init (l,u) ies = do
287 marr <- newArray (l,u) init
289 old <- unsafeRead marr i
290 unsafeWrite marr i (f old new)
292 unsafeFreezeSTUArray marr
294 {-# INLINE eqUArray #-}
295 eqUArray :: (IArray UArray e, Ix i, Eq e) => UArray i e -> UArray i e -> Bool
296 eqUArray arr1@(UArray l1 u1 _) arr2@(UArray l2 u2 _) =
297 if rangeSize (l1,u1) == 0 then rangeSize (l2,u2) == 0 else
298 l1 == l2 && u1 == u2 &&
299 and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. rangeSize (l1,u1) - 1]]
301 {-# INLINE cmpUArray #-}
302 cmpUArray :: (IArray UArray e, Ix i, Ord e) => UArray i e -> UArray i e -> Ordering
303 cmpUArray arr1 arr2 = compare (assocs arr1) (assocs arr2)
305 {-# INLINE cmpIntUArray #-}
306 cmpIntUArray :: (IArray UArray e, Ord e) => UArray Int e -> UArray Int e -> Ordering
307 cmpIntUArray arr1@(UArray l1 u1 _) arr2@(UArray l2 u2 _) =
308 if rangeSize (l1,u1) == 0 then if rangeSize (l2,u2) == 0 then EQ else LT else
309 if rangeSize (l2,u2) == 0 then GT else
310 case compare l1 l2 of
311 EQ -> foldr cmp (compare u1 u2) [0 .. rangeSize (l1, min u1 u2) - 1]
314 cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of
318 {-# RULES "cmpUArray/Int" cmpUArray = cmpIntUArray #-}
320 showsUArray :: (IArray UArray e, Ix i, Show i, Show e)
321 => Int -> UArray i e -> ShowS
324 showString "array " .
329 -----------------------------------------------------------------------------
330 -- Flat unboxed arrays: instances
332 instance IArray UArray Bool where
333 {-# INLINE unsafeArray #-}
334 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
335 {-# INLINE unsafeAt #-}
336 unsafeAt (UArray _ _ arr#) (I# i#) =
337 (indexWordArray# arr# (bOOL_INDEX i#) `and#` bOOL_BIT i#)
338 `neWord#` int2Word# 0#
339 {-# INLINE unsafeReplace #-}
340 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
341 {-# INLINE unsafeAccum #-}
342 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
343 {-# INLINE unsafeAccumArray #-}
344 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
346 instance IArray UArray Char where
347 {-# INLINE unsafeArray #-}
348 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
349 {-# INLINE unsafeAt #-}
350 unsafeAt (UArray _ _ arr#) (I# i#) = C# (indexWideCharArray# arr# i#)
351 {-# INLINE unsafeReplace #-}
352 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
353 {-# INLINE unsafeAccum #-}
354 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
355 {-# INLINE unsafeAccumArray #-}
356 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
358 instance IArray UArray Int where
359 {-# INLINE unsafeArray #-}
360 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
361 {-# INLINE unsafeAt #-}
362 unsafeAt (UArray _ _ arr#) (I# i#) = I# (indexIntArray# arr# i#)
363 {-# INLINE unsafeReplace #-}
364 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
365 {-# INLINE unsafeAccum #-}
366 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
367 {-# INLINE unsafeAccumArray #-}
368 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
370 instance IArray UArray Word where
371 {-# INLINE unsafeArray #-}
372 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
373 {-# INLINE unsafeAt #-}
374 unsafeAt (UArray _ _ arr#) (I# i#) = W# (indexWordArray# arr# i#)
375 {-# INLINE unsafeReplace #-}
376 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
377 {-# INLINE unsafeAccum #-}
378 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
379 {-# INLINE unsafeAccumArray #-}
380 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
382 instance IArray UArray (Ptr a) where
383 {-# INLINE unsafeArray #-}
384 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
385 {-# INLINE unsafeAt #-}
386 unsafeAt (UArray _ _ arr#) (I# i#) = Ptr (indexAddrArray# arr# i#)
387 {-# INLINE unsafeReplace #-}
388 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
389 {-# INLINE unsafeAccum #-}
390 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
391 {-# INLINE unsafeAccumArray #-}
392 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
394 instance IArray UArray (FunPtr a) where
395 {-# INLINE unsafeArray #-}
396 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
397 {-# INLINE unsafeAt #-}
398 unsafeAt (UArray _ _ arr#) (I# i#) = FunPtr (indexAddrArray# arr# i#)
399 {-# INLINE unsafeReplace #-}
400 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
401 {-# INLINE unsafeAccum #-}
402 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
403 {-# INLINE unsafeAccumArray #-}
404 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
406 instance IArray UArray Float where
407 {-# INLINE unsafeArray #-}
408 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
409 {-# INLINE unsafeAt #-}
410 unsafeAt (UArray _ _ arr#) (I# i#) = F# (indexFloatArray# arr# i#)
411 {-# INLINE unsafeReplace #-}
412 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
413 {-# INLINE unsafeAccum #-}
414 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
415 {-# INLINE unsafeAccumArray #-}
416 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
418 instance IArray UArray Double where
419 {-# INLINE unsafeArray #-}
420 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
421 {-# INLINE unsafeAt #-}
422 unsafeAt (UArray _ _ arr#) (I# i#) = D# (indexDoubleArray# arr# i#)
423 {-# INLINE unsafeReplace #-}
424 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
425 {-# INLINE unsafeAccum #-}
426 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
427 {-# INLINE unsafeAccumArray #-}
428 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
430 instance IArray UArray (StablePtr a) where
431 {-# INLINE unsafeArray #-}
432 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
433 {-# INLINE unsafeAt #-}
434 unsafeAt (UArray _ _ arr#) (I# i#) = StablePtr (indexStablePtrArray# arr# i#)
435 {-# INLINE unsafeReplace #-}
436 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
437 {-# INLINE unsafeAccum #-}
438 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
439 {-# INLINE unsafeAccumArray #-}
440 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
442 instance IArray UArray Int8 where
443 {-# INLINE unsafeArray #-}
444 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
445 {-# INLINE unsafeAt #-}
446 unsafeAt (UArray _ _ arr#) (I# i#) = I8# (indexInt8Array# arr# i#)
447 {-# INLINE unsafeReplace #-}
448 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
449 {-# INLINE unsafeAccum #-}
450 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
451 {-# INLINE unsafeAccumArray #-}
452 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
454 instance IArray UArray Int16 where
455 {-# INLINE unsafeArray #-}
456 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
457 {-# INLINE unsafeAt #-}
458 unsafeAt (UArray _ _ arr#) (I# i#) = I16# (indexInt16Array# arr# i#)
459 {-# INLINE unsafeReplace #-}
460 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
461 {-# INLINE unsafeAccum #-}
462 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
463 {-# INLINE unsafeAccumArray #-}
464 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
466 instance IArray UArray Int32 where
467 {-# INLINE unsafeArray #-}
468 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
469 {-# INLINE unsafeAt #-}
470 unsafeAt (UArray _ _ arr#) (I# i#) = I32# (indexInt32Array# arr# i#)
471 {-# INLINE unsafeReplace #-}
472 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
473 {-# INLINE unsafeAccum #-}
474 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
475 {-# INLINE unsafeAccumArray #-}
476 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
478 instance IArray UArray Int64 where
479 {-# INLINE unsafeArray #-}
480 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
481 {-# INLINE unsafeAt #-}
482 unsafeAt (UArray _ _ arr#) (I# i#) =
483 #if WORD_SIZE_IN_BYTES == 4
484 I64# (indexInt64Array# arr# i#)
486 I64# (indexIntArray# arr# i#)
488 {-# INLINE unsafeReplace #-}
489 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
490 {-# INLINE unsafeAccum #-}
491 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
492 {-# INLINE unsafeAccumArray #-}
493 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
495 instance IArray UArray Word8 where
496 {-# INLINE unsafeArray #-}
497 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
498 {-# INLINE unsafeAt #-}
499 unsafeAt (UArray _ _ arr#) (I# i#) = W8# (indexWord8Array# arr# i#)
500 {-# INLINE unsafeReplace #-}
501 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
502 {-# INLINE unsafeAccum #-}
503 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
504 {-# INLINE unsafeAccumArray #-}
505 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
507 instance IArray UArray Word16 where
508 {-# INLINE unsafeArray #-}
509 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
510 {-# INLINE unsafeAt #-}
511 unsafeAt (UArray _ _ arr#) (I# i#) = W16# (indexWord16Array# arr# i#)
512 {-# INLINE unsafeReplace #-}
513 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
514 {-# INLINE unsafeAccum #-}
515 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
516 {-# INLINE unsafeAccumArray #-}
517 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
519 instance IArray UArray Word32 where
520 {-# INLINE unsafeArray #-}
521 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
522 {-# INLINE unsafeAt #-}
523 unsafeAt (UArray _ _ arr#) (I# i#) = W32# (indexWord32Array# arr# i#)
524 {-# INLINE unsafeReplace #-}
525 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
526 {-# INLINE unsafeAccum #-}
527 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
528 {-# INLINE unsafeAccumArray #-}
529 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
531 instance IArray UArray Word64 where
532 {-# INLINE unsafeArray #-}
533 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
534 {-# INLINE unsafeAt #-}
535 unsafeAt (UArray _ _ arr#) (I# i#) =
536 #if WORD_SIZE_IN_BYTES == 4
537 W64# (indexWord64Array# arr# i#)
539 W64# (indexWordArray# arr# i#)
541 {-# INLINE unsafeReplace #-}
542 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
543 {-# INLINE unsafeAccum #-}
544 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
545 {-# INLINE unsafeAccumArray #-}
546 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
548 instance Ix ix => Eq (UArray ix Bool) where
551 instance Ix ix => Eq (UArray ix Char) where
554 instance Ix ix => Eq (UArray ix Int) where
557 instance Ix ix => Eq (UArray ix Word) where
560 instance Ix ix => Eq (UArray ix (Ptr a)) where
563 instance Ix ix => Eq (UArray ix (FunPtr a)) where
566 instance Ix ix => Eq (UArray ix Float) where
569 instance Ix ix => Eq (UArray ix Double) where
572 instance Ix ix => Eq (UArray ix (StablePtr a)) where
575 instance Ix ix => Eq (UArray ix Int8) where
578 instance Ix ix => Eq (UArray ix Int16) where
581 instance Ix ix => Eq (UArray ix Int32) where
584 instance Ix ix => Eq (UArray ix Int64) where
587 instance Ix ix => Eq (UArray ix Word8) where
590 instance Ix ix => Eq (UArray ix Word16) where
593 instance Ix ix => Eq (UArray ix Word32) where
596 instance Ix ix => Eq (UArray ix Word64) where
599 instance Ix ix => Ord (UArray ix Bool) where
602 instance Ix ix => Ord (UArray ix Char) where
605 instance Ix ix => Ord (UArray ix Int) where
608 instance Ix ix => Ord (UArray ix Word) where
611 instance Ix ix => Ord (UArray ix (Ptr a)) where
614 instance Ix ix => Ord (UArray ix (FunPtr a)) where
617 instance Ix ix => Ord (UArray ix Float) where
620 instance Ix ix => Ord (UArray ix Double) where
623 instance Ix ix => Ord (UArray ix Int8) where
626 instance Ix ix => Ord (UArray ix Int16) where
629 instance Ix ix => Ord (UArray ix Int32) where
632 instance Ix ix => Ord (UArray ix Int64) where
635 instance Ix ix => Ord (UArray ix Word8) where
638 instance Ix ix => Ord (UArray ix Word16) where
641 instance Ix ix => Ord (UArray ix Word32) where
644 instance Ix ix => Ord (UArray ix Word64) where
647 instance (Ix ix, Show ix) => Show (UArray ix Bool) where
648 showsPrec = showsUArray
650 instance (Ix ix, Show ix) => Show (UArray ix Char) where
651 showsPrec = showsUArray
653 instance (Ix ix, Show ix) => Show (UArray ix Int) where
654 showsPrec = showsUArray
656 instance (Ix ix, Show ix) => Show (UArray ix Word) where
657 showsPrec = showsUArray
659 instance (Ix ix, Show ix) => Show (UArray ix Float) where
660 showsPrec = showsUArray
662 instance (Ix ix, Show ix) => Show (UArray ix Double) where
663 showsPrec = showsUArray
665 instance (Ix ix, Show ix) => Show (UArray ix Int8) where
666 showsPrec = showsUArray
668 instance (Ix ix, Show ix) => Show (UArray ix Int16) where
669 showsPrec = showsUArray
671 instance (Ix ix, Show ix) => Show (UArray ix Int32) where
672 showsPrec = showsUArray
674 instance (Ix ix, Show ix) => Show (UArray ix Int64) where
675 showsPrec = showsUArray
677 instance (Ix ix, Show ix) => Show (UArray ix Word8) where
678 showsPrec = showsUArray
680 instance (Ix ix, Show ix) => Show (UArray ix Word16) where
681 showsPrec = showsUArray
683 instance (Ix ix, Show ix) => Show (UArray ix Word32) where
684 showsPrec = showsUArray
686 instance (Ix ix, Show ix) => Show (UArray ix Word64) where
687 showsPrec = showsUArray
689 -----------------------------------------------------------------------------
692 {-# NOINLINE arrEleBottom #-}
694 arrEleBottom = error "MArray: undefined array element"
696 class (HasBounds a, Monad m) => MArray a e m where
697 newArray :: Ix i => (i,i) -> e -> m (a i e)
698 newArray_ :: Ix i => (i,i) -> m (a i e)
699 unsafeRead :: Ix i => a i e -> Int -> m e
700 unsafeWrite :: Ix i => a i e -> Int -> e -> m ()
702 newArray (l,u) init = do
703 marr <- newArray_ (l,u)
704 sequence_ [unsafeWrite marr i init | i <- [0 .. rangeSize (l,u) - 1]]
707 newArray_ (l,u) = newArray (l,u) arrEleBottom
709 -- newArray takes an initialiser which all elements of
710 -- the newly created array are initialised to. newArray_ takes
711 -- no initialiser, it is assumed that the array is initialised with
712 -- "undefined" values.
714 -- why not omit newArray_? Because in the unboxed array case we would
715 -- like to omit the initialisation altogether if possible. We can't do
716 -- this for boxed arrays, because the elements must all have valid values
717 -- at all times in case of garbage collection.
719 -- why not omit newArray? Because in the boxed case, we can omit the
720 -- default initialisation with undefined values if we *do* know the
721 -- initial value and it is constant for all elements.
723 {-# INLINE newListArray #-}
724 newListArray :: (MArray a e m, Ix i) => (i,i) -> [e] -> m (a i e)
725 newListArray (l,u) es = do
726 marr <- newArray_ (l,u)
727 let n = rangeSize (l,u)
728 let fillFromList i xs | i == n = return ()
729 | otherwise = case xs of
731 y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys
735 {-# INLINE readArray #-}
736 readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
737 readArray marr i | (l,u) <- bounds marr =
738 unsafeRead marr (index (l,u) i)
740 {-# INLINE writeArray #-}
741 writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
742 writeArray marr i e | (l,u) <- bounds marr =
743 unsafeWrite marr (index (l,u) i) e
745 {-# INLINE getElems #-}
746 getElems :: (MArray a e m, Ix i) => a i e -> m [e]
747 getElems marr | (l,u) <- bounds marr =
748 sequence [unsafeRead marr i | i <- [0 .. rangeSize (l,u) - 1]]
750 {-# INLINE getAssocs #-}
751 getAssocs :: (MArray a e m, Ix i) => a i e -> m [(i, e)]
752 getAssocs marr | (l,u) <- bounds marr =
753 sequence [do e <- unsafeRead marr (index (l,u) i); return (i,e)
756 {-# INLINE mapArray #-}
757 mapArray :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e)
758 mapArray f marr | (l,u) <- bounds marr = do
759 marr' <- newArray_ (l,u)
761 e <- unsafeRead marr i
762 unsafeWrite marr' i (f e)
763 | i <- [0 .. rangeSize (l,u) - 1]]
766 {-# INLINE mapIndices #-}
767 mapIndices :: (MArray a e m, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> m (a i e)
768 mapIndices (l,u) f marr = do
769 marr' <- newArray_ (l,u)
771 e <- readArray marr (f i)
772 unsafeWrite marr' (unsafeIndex (l,u) i) e
776 -----------------------------------------------------------------------------
777 -- Polymorphic non-strict mutable arrays (ST monad)
779 instance HasBounds (STArray s) where
780 {-# INLINE bounds #-}
781 bounds = GHC.Arr.boundsSTArray
783 instance MArray (STArray s) e (ST s) where
784 {-# INLINE newArray #-}
785 newArray = GHC.Arr.newSTArray
786 {-# INLINE unsafeRead #-}
787 unsafeRead = GHC.Arr.unsafeReadSTArray
788 {-# INLINE unsafeWrite #-}
789 unsafeWrite = GHC.Arr.unsafeWriteSTArray
791 -----------------------------------------------------------------------------
792 -- Typeable instance for STArray
795 sTArrayTc = mkTyCon "STArray"
797 instance (Typeable a, Typeable b, Typeable c) => Typeable (STArray a b c) where
798 typeOf a = mkAppTy sTArrayTc [typeOf ((undefined :: STArray a b c -> a) a),
799 typeOf ((undefined :: STArray a b c -> b) a),
800 typeOf ((undefined :: STArray a b c -> c) a)]
802 -----------------------------------------------------------------------------
803 -- Flat unboxed mutable arrays (ST monad)
805 data STUArray s i a = STUArray !i !i (MutableByteArray# s)
807 INSTANCE_TYPEABLE3(STUArray,stUArrayTc,"STUArray")
809 instance HasBounds (STUArray s) where
810 {-# INLINE bounds #-}
811 bounds (STUArray l u _) = (l,u)
813 instance MArray (STUArray s) Bool (ST s) where
814 {-# INLINE newArray #-}
815 newArray (l,u) init = ST $ \s1# ->
816 case rangeSize (l,u) of { I# n# ->
817 case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
818 case bOOL_WORD_SCALE n# of { n'# ->
819 let loop i# s3# | i# ==# n'# = s3#
821 case writeWordArray# marr# i# e# s3# of { s4# ->
822 loop (i# +# 1#) s4# } in
823 case loop 0# s2# of { s3# ->
824 (# s3#, STUArray l u marr# #) }}}}
826 W# e# = if init then maxBound else 0
827 {-# INLINE newArray_ #-}
828 newArray_ (l,u) = ST $ \s1# ->
829 case rangeSize (l,u) of { I# n# ->
830 case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
831 (# s2#, STUArray l u marr# #) }}
832 {-# INLINE unsafeRead #-}
833 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
834 case readWordArray# marr# (bOOL_INDEX i#) s1# of { (# s2#, e# #) ->
835 (# s2#, (e# `and#` bOOL_BIT i#) `neWord#` int2Word# 0# #) }
836 {-# INLINE unsafeWrite #-}
837 unsafeWrite (STUArray _ _ marr#) (I# i#) e = ST $ \s1# ->
838 case bOOL_INDEX i# of { j# ->
839 case readWordArray# marr# j# s1# of { (# s2#, old# #) ->
840 case if e then old# `or#` bOOL_BIT i#
841 else old# `and#` bOOL_NOT_BIT i# of { e# ->
842 case writeWordArray# marr# j# e# s2# of { s3# ->
845 instance MArray (STUArray s) Char (ST s) where
846 {-# INLINE newArray_ #-}
847 newArray_ (l,u) = ST $ \s1# ->
848 case rangeSize (l,u) of { I# n# ->
849 case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
850 (# s2#, STUArray l u marr# #) }}
851 {-# INLINE unsafeRead #-}
852 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
853 case readWideCharArray# marr# i# s1# of { (# s2#, e# #) ->
855 {-# INLINE unsafeWrite #-}
856 unsafeWrite (STUArray _ _ marr#) (I# i#) (C# e#) = ST $ \s1# ->
857 case writeWideCharArray# marr# i# e# s1# of { s2# ->
860 instance MArray (STUArray s) Int (ST s) where
861 {-# INLINE newArray_ #-}
862 newArray_ (l,u) = ST $ \s1# ->
863 case rangeSize (l,u) of { I# n# ->
864 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
865 (# s2#, STUArray l u marr# #) }}
866 {-# INLINE unsafeRead #-}
867 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
868 case readIntArray# marr# i# s1# of { (# s2#, e# #) ->
870 {-# INLINE unsafeWrite #-}
871 unsafeWrite (STUArray _ _ marr#) (I# i#) (I# e#) = ST $ \s1# ->
872 case writeIntArray# marr# i# e# s1# of { s2# ->
875 instance MArray (STUArray s) Word (ST s) where
876 {-# INLINE newArray_ #-}
877 newArray_ (l,u) = ST $ \s1# ->
878 case rangeSize (l,u) of { I# n# ->
879 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
880 (# s2#, STUArray l u marr# #) }}
881 {-# INLINE unsafeRead #-}
882 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
883 case readWordArray# marr# i# s1# of { (# s2#, e# #) ->
885 {-# INLINE unsafeWrite #-}
886 unsafeWrite (STUArray _ _ marr#) (I# i#) (W# e#) = ST $ \s1# ->
887 case writeWordArray# marr# i# e# s1# of { s2# ->
890 instance MArray (STUArray s) (Ptr a) (ST s) where
891 {-# INLINE newArray_ #-}
892 newArray_ (l,u) = ST $ \s1# ->
893 case rangeSize (l,u) of { I# n# ->
894 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
895 (# s2#, STUArray l u marr# #) }}
896 {-# INLINE unsafeRead #-}
897 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
898 case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
900 {-# INLINE unsafeWrite #-}
901 unsafeWrite (STUArray _ _ marr#) (I# i#) (Ptr e#) = ST $ \s1# ->
902 case writeAddrArray# marr# i# e# s1# of { s2# ->
905 instance MArray (STUArray s) (FunPtr a) (ST s) where
906 {-# INLINE newArray_ #-}
907 newArray_ (l,u) = ST $ \s1# ->
908 case rangeSize (l,u) of { I# n# ->
909 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
910 (# s2#, STUArray l u marr# #) }}
911 {-# INLINE unsafeRead #-}
912 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
913 case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
914 (# s2#, FunPtr e# #) }
915 {-# INLINE unsafeWrite #-}
916 unsafeWrite (STUArray _ _ marr#) (I# i#) (FunPtr e#) = ST $ \s1# ->
917 case writeAddrArray# marr# i# e# s1# of { s2# ->
920 instance MArray (STUArray s) Float (ST s) where
921 {-# INLINE newArray_ #-}
922 newArray_ (l,u) = ST $ \s1# ->
923 case rangeSize (l,u) of { I# n# ->
924 case newByteArray# (fLOAT_SCALE n#) s1# of { (# s2#, marr# #) ->
925 (# s2#, STUArray l u marr# #) }}
926 {-# INLINE unsafeRead #-}
927 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
928 case readFloatArray# marr# i# s1# of { (# s2#, e# #) ->
930 {-# INLINE unsafeWrite #-}
931 unsafeWrite (STUArray _ _ marr#) (I# i#) (F# e#) = ST $ \s1# ->
932 case writeFloatArray# marr# i# e# s1# of { s2# ->
935 instance MArray (STUArray s) Double (ST s) where
936 {-# INLINE newArray_ #-}
937 newArray_ (l,u) = ST $ \s1# ->
938 case rangeSize (l,u) of { I# n# ->
939 case newByteArray# (dOUBLE_SCALE n#) s1# of { (# s2#, marr# #) ->
940 (# s2#, STUArray l u marr# #) }}
941 {-# INLINE unsafeRead #-}
942 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
943 case readDoubleArray# marr# i# s1# of { (# s2#, e# #) ->
945 {-# INLINE unsafeWrite #-}
946 unsafeWrite (STUArray _ _ marr#) (I# i#) (D# e#) = ST $ \s1# ->
947 case writeDoubleArray# marr# i# e# s1# of { s2# ->
950 instance MArray (STUArray s) (StablePtr a) (ST s) where
951 {-# INLINE newArray_ #-}
952 newArray_ (l,u) = ST $ \s1# ->
953 case rangeSize (l,u) of { I# n# ->
954 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
955 (# s2#, STUArray l u marr# #) }}
956 {-# INLINE unsafeRead #-}
957 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
958 case readStablePtrArray# marr# i# s1# of { (# s2#, e# #) ->
959 (# s2# , StablePtr e# #) }
960 {-# INLINE unsafeWrite #-}
961 unsafeWrite (STUArray _ _ marr#) (I# i#) (StablePtr e#) = ST $ \s1# ->
962 case writeStablePtrArray# marr# i# e# s1# of { s2# ->
965 instance MArray (STUArray s) Int8 (ST s) where
966 {-# INLINE newArray_ #-}
967 newArray_ (l,u) = ST $ \s1# ->
968 case rangeSize (l,u) of { I# n# ->
969 case newByteArray# n# s1# of { (# s2#, marr# #) ->
970 (# s2#, STUArray l u marr# #) }}
971 {-# INLINE unsafeRead #-}
972 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
973 case readInt8Array# marr# i# s1# of { (# s2#, e# #) ->
975 {-# INLINE unsafeWrite #-}
976 unsafeWrite (STUArray _ _ marr#) (I# i#) (I8# e#) = ST $ \s1# ->
977 case writeInt8Array# marr# i# e# s1# of { s2# ->
980 instance MArray (STUArray s) Int16 (ST s) where
981 {-# INLINE newArray_ #-}
982 newArray_ (l,u) = ST $ \s1# ->
983 case rangeSize (l,u) of { I# n# ->
984 case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) ->
985 (# s2#, STUArray l u marr# #) }}
986 {-# INLINE unsafeRead #-}
987 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
988 case readInt16Array# marr# i# s1# of { (# s2#, e# #) ->
990 {-# INLINE unsafeWrite #-}
991 unsafeWrite (STUArray _ _ marr#) (I# i#) (I16# e#) = ST $ \s1# ->
992 case writeInt16Array# marr# i# e# s1# of { s2# ->
995 instance MArray (STUArray s) Int32 (ST s) where
996 {-# INLINE newArray_ #-}
997 newArray_ (l,u) = ST $ \s1# ->
998 case rangeSize (l,u) of { I# n# ->
999 case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
1000 (# s2#, STUArray l u marr# #) }}
1001 {-# INLINE unsafeRead #-}
1002 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1003 case readInt32Array# marr# i# s1# of { (# s2#, e# #) ->
1004 (# s2#, I32# e# #) }
1005 {-# INLINE unsafeWrite #-}
1006 unsafeWrite (STUArray _ _ marr#) (I# i#) (I32# e#) = ST $ \s1# ->
1007 case writeInt32Array# marr# i# e# s1# of { s2# ->
1010 instance MArray (STUArray s) Int64 (ST s) where
1011 {-# INLINE newArray_ #-}
1012 newArray_ (l,u) = ST $ \s1# ->
1013 case rangeSize (l,u) of { I# n# ->
1014 case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) ->
1015 (# s2#, STUArray l u marr# #) }}
1016 {-# INLINE unsafeRead #-}
1017 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1018 #if WORD_SIZE_IN_BYTES == 4
1019 case readInt64Array# marr# i# s1# of { (# s2#, e# #) ->
1021 case readIntArray# marr# i# s1# of { (# s2#, e# #) ->
1023 (# s2#, I64# e# #) }
1024 {-# INLINE unsafeWrite #-}
1025 unsafeWrite (STUArray _ _ marr#) (I# i#) (I64# e#) = ST $ \s1# ->
1026 #if WORD_SIZE_IN_BYTES == 4
1027 case writeInt64Array# marr# i# e# s1# of { s2# ->
1029 case writeIntArray# marr# i# e# s1# of { s2# ->
1033 instance MArray (STUArray s) Word8 (ST s) where
1034 {-# INLINE newArray_ #-}
1035 newArray_ (l,u) = ST $ \s1# ->
1036 case rangeSize (l,u) of { I# n# ->
1037 case newByteArray# n# s1# of { (# s2#, marr# #) ->
1038 (# s2#, STUArray l u marr# #) }}
1039 {-# INLINE unsafeRead #-}
1040 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1041 case readWord8Array# marr# i# s1# of { (# s2#, e# #) ->
1043 {-# INLINE unsafeWrite #-}
1044 unsafeWrite (STUArray _ _ marr#) (I# i#) (W8# e#) = ST $ \s1# ->
1045 case writeWord8Array# marr# i# e# s1# of { s2# ->
1048 instance MArray (STUArray s) Word16 (ST s) where
1049 {-# INLINE newArray_ #-}
1050 newArray_ (l,u) = ST $ \s1# ->
1051 case rangeSize (l,u) of { I# n# ->
1052 case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) ->
1053 (# s2#, STUArray l u marr# #) }}
1054 {-# INLINE unsafeRead #-}
1055 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1056 case readWord16Array# marr# i# s1# of { (# s2#, e# #) ->
1057 (# s2#, W16# e# #) }
1058 {-# INLINE unsafeWrite #-}
1059 unsafeWrite (STUArray _ _ marr#) (I# i#) (W16# e#) = ST $ \s1# ->
1060 case writeWord16Array# marr# i# e# s1# of { s2# ->
1063 instance MArray (STUArray s) Word32 (ST s) where
1064 {-# INLINE newArray_ #-}
1065 newArray_ (l,u) = ST $ \s1# ->
1066 case rangeSize (l,u) of { I# n# ->
1067 case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
1068 (# s2#, STUArray l u marr# #) }}
1069 {-# INLINE unsafeRead #-}
1070 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1071 case readWord32Array# marr# i# s1# of { (# s2#, e# #) ->
1072 (# s2#, W32# e# #) }
1073 {-# INLINE unsafeWrite #-}
1074 unsafeWrite (STUArray _ _ marr#) (I# i#) (W32# e#) = ST $ \s1# ->
1075 case writeWord32Array# marr# i# e# s1# of { s2# ->
1078 instance MArray (STUArray s) Word64 (ST s) where
1079 {-# INLINE newArray_ #-}
1080 newArray_ (l,u) = ST $ \s1# ->
1081 case rangeSize (l,u) of { I# n# ->
1082 case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) ->
1083 (# s2#, STUArray l u marr# #) }}
1084 {-# INLINE unsafeRead #-}
1085 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1086 #if WORD_SIZE_IN_BYTES == 4
1087 case readWord64Array# marr# i# s1# of { (# s2#, e# #) ->
1089 case readWordArray# marr# i# s1# of { (# s2#, e# #) ->
1091 (# s2#, W64# e# #) }
1092 {-# INLINE unsafeWrite #-}
1093 unsafeWrite (STUArray _ _ marr#) (I# i#) (W64# e#) = ST $ \s1# ->
1094 #if WORD_SIZE_IN_BYTES == 4
1095 case writeWord64Array# marr# i# e# s1# of { s2# ->
1097 case writeWordArray# marr# i# e# s1# of { s2# ->
1101 -----------------------------------------------------------------------------
1102 -- Translation between elements and bytes
1104 bOOL_SCALE, bOOL_WORD_SCALE,
1105 wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int#
1106 bOOL_SCALE n# = (n# +# last#) `iShiftRA#` 3#
1107 where I# last# = WORD_SIZE_IN_BYTES * 8 - 1
1108 bOOL_WORD_SCALE n# = bOOL_INDEX (n# +# last#)
1109 where I# last# = WORD_SIZE_IN_BYTES * 8 - 1
1110 wORD_SCALE n# = scale# *# n# where I# scale# = WORD_SIZE_IN_BYTES
1111 dOUBLE_SCALE n# = scale# *# n# where I# scale# = DOUBLE_SIZE_IN_BYTES
1112 fLOAT_SCALE n# = scale# *# n# where I# scale# = FLOAT_SIZE_IN_BYTES
1114 bOOL_INDEX :: Int# -> Int#
1115 #if WORD_SIZE_IN_BYTES == 4
1116 bOOL_INDEX i# = i# `iShiftRA#` 5#
1117 #elif WORD_SIZE_IN_BYTES == 8
1118 bOOL_INDEX i# = i# `iShiftRA#` 6#
1121 bOOL_BIT, bOOL_NOT_BIT :: Int# -> Word#
1122 bOOL_BIT n# = int2Word# 1# `shiftL#` (word2Int# (int2Word# n# `and#` mask#))
1123 where W# mask# = WORD_SIZE_IN_BYTES * 8 - 1
1124 bOOL_NOT_BIT n# = bOOL_BIT n# `xor#` mb# where W# mb# = maxBound
1126 -----------------------------------------------------------------------------
1129 freeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
1130 freeze marr | (l,u) <- bounds marr = do
1131 ies <- sequence [do e <- unsafeRead marr i; return (i,e)
1132 | i <- [0 .. rangeSize (l,u) - 1]]
1133 return (unsafeArray (l,u) ies)
1135 freezeSTUArray :: Ix i => STUArray s i e -> ST s (UArray i e)
1136 freezeSTUArray (STUArray l u marr#) = ST $ \s1# ->
1137 case sizeofMutableByteArray# marr# of { n# ->
1138 case newByteArray# n# s1# of { (# s2#, marr'# #) ->
1139 case unsafeCoerce# memcpy marr'# marr# n# s2# of { (# s3#, () #) ->
1140 case unsafeFreezeByteArray# marr'# s3# of { (# s4#, arr# #) ->
1141 (# s4#, UArray l u arr# #) }}}}
1144 "freeze/STArray" freeze = GHC.Arr.freezeSTArray
1145 "freeze/STUArray" freeze = freezeSTUArray
1148 -- In-place conversion of mutable arrays to immutable ones places
1149 -- a proof obligation on the user: no other parts of your code can
1150 -- have a reference to the array at the point where you unsafely
1151 -- freeze it (and, subsequently mutate it, I suspect).
1153 {-# INLINE unsafeFreeze #-}
1154 unsafeFreeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
1155 unsafeFreeze = freeze
1158 "unsafeFreeze/STArray" unsafeFreeze = GHC.Arr.unsafeFreezeSTArray
1159 "unsafeFreeze/STUArray" unsafeFreeze = unsafeFreezeSTUArray
1162 -----------------------------------------------------------------------------
1165 thaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
1166 thaw arr | (l,u) <- bounds arr = do
1167 marr <- newArray_ (l,u)
1168 sequence_ [unsafeWrite marr i (unsafeAt arr i)
1169 | i <- [0 .. rangeSize (l,u) - 1]]
1172 thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1173 thawSTUArray (UArray l u arr#) = ST $ \s1# ->
1174 case sizeofByteArray# arr# of { n# ->
1175 case newByteArray# n# s1# of { (# s2#, marr# #) ->
1176 case unsafeCoerce# memcpy marr# arr# n# s2# of { (# s3#, () #) ->
1177 (# s3#, STUArray l u marr# #) }}}
1179 foreign import "memcpy" unsafe
1180 memcpy :: MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO ()
1183 "thaw/STArray" thaw = GHC.Arr.thawSTArray
1184 "thaw/STUArray" thaw = thawSTUArray
1187 -- In-place conversion of immutable arrays to mutable ones places
1188 -- a proof obligation on the user: no other parts of your code can
1189 -- have a reference to the array at the point where you unsafely
1190 -- thaw it (and, subsequently mutate it, I suspect).
1192 {-# INLINE unsafeThaw #-}
1193 unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
1196 {-# INLINE unsafeThawSTUArray #-}
1197 unsafeThawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1198 unsafeThawSTUArray (UArray l u marr#) =
1199 return (STUArray l u (unsafeCoerce# marr#))
1202 "unsafeThaw/STArray" unsafeThaw = GHC.Arr.unsafeThawSTArray
1203 "unsafeThaw/STUArray" unsafeThaw = unsafeThawSTUArray