[project @ 2005-10-13 11:09:50 by ross]
[packages/containers.git] / Data / Array / Base.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Data.Array.Base
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/base/LICENSE)
6 --
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable (MPTCs, uses Control.Monad.ST)
10 --
11 -- Basis for IArray and MArray. Not intended for external consumption;
12 -- use IArray or MArray instead.
13 --
14 -----------------------------------------------------------------------------
15
16 -- #hide
17 module Data.Array.Base where
18
19 import Prelude
20
21 import Control.Monad.ST.Lazy ( strictToLazyST )
22 import qualified Control.Monad.ST.Lazy as Lazy (ST)
23 import Data.Ix ( Ix, range, index, rangeSize )
24 import Data.Int
25 import Data.Word
26 import Foreign.Ptr
27 import Foreign.StablePtr
28
29 #ifdef __GLASGOW_HASKELL__
30 import GHC.Arr ( STArray, unsafeIndex )
31 import qualified GHC.Arr as Arr
32 import qualified GHC.Arr as ArrST
33 import GHC.ST ( ST(..), runST )
34 import GHC.Base
35 import GHC.Word ( Word(..) )
36 import GHC.Ptr ( Ptr(..), FunPtr(..), nullPtr, nullFunPtr )
37 import GHC.Float ( Float(..), Double(..) )
38 import GHC.Stable ( StablePtr(..) )
39 import GHC.Int ( Int8(..), Int16(..), Int32(..), Int64(..) )
40 import GHC.Word ( Word8(..), Word16(..), Word32(..), Word64(..) )
41 #endif
42
43 #ifdef __HUGS__
44 import Data.Bits
45 import Foreign.Storable
46 import qualified Hugs.Array as Arr
47 import qualified Hugs.ST as ArrST
48 import Hugs.Array ( unsafeIndex )
49 import Hugs.ST ( STArray, ST(..), runST )
50 import Hugs.ByteArray
51 #endif
52
53 import Data.Typeable
54 #include "Typeable.h"
55
56 #include "MachDeps.h"
57
58 -----------------------------------------------------------------------------
59 -- Class of immutable arrays
60
61 -- | Class of array types with immutable bounds
62 -- (even if the array elements are mutable).
63 class HasBounds a where
64 -- | Extracts the bounds of an array
65 bounds :: Ix i => a i e -> (i,i)
66
67 {- | Class of immutable array types.
68
69 An array type has the form @(a i e)@ where @a@ is the array type
70 constructor (kind @* -> * -> *@), @i@ is the index type (a member of
71 the class 'Ix'), and @e@ is the element type. The @IArray@ class is
72 parameterised over both @a@ and @e@, so that instances specialised to
73 certain element types can be defined.
74 -}
75 class HasBounds a => IArray a e where
76 unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> a i e
77 unsafeAt :: Ix i => a i e -> Int -> e
78 unsafeReplace :: Ix i => a i e -> [(Int, e)] -> a i e
79 unsafeAccum :: Ix i => (e -> e' -> e) -> a i e -> [(Int, e')] -> a i e
80 unsafeAccumArray :: Ix i => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> a i e
81
82 unsafeReplace arr ies = runST (unsafeReplaceST arr ies >>= unsafeFreeze)
83 unsafeAccum f arr ies = runST (unsafeAccumST f arr ies >>= unsafeFreeze)
84 unsafeAccumArray f e lu ies = runST (unsafeAccumArrayST f e lu ies >>= unsafeFreeze)
85
86 {-# INLINE unsafeReplaceST #-}
87 unsafeReplaceST :: (IArray a e, Ix i) => a i e -> [(Int, e)] -> ST s (STArray s i e)
88 unsafeReplaceST arr ies = do
89 marr <- thaw arr
90 sequence_ [unsafeWrite marr i e | (i, e) <- ies]
91 return marr
92
93 {-# INLINE unsafeAccumST #-}
94 unsafeAccumST :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(Int, e')] -> ST s (STArray s i e)
95 unsafeAccumST f arr ies = do
96 marr <- thaw arr
97 sequence_ [do
98 old <- unsafeRead marr i
99 unsafeWrite marr i (f old new)
100 | (i, new) <- ies]
101 return marr
102
103 {-# INLINE unsafeAccumArrayST #-}
104 unsafeAccumArrayST :: Ix i => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (STArray s i e)
105 unsafeAccumArrayST f e (l,u) ies = do
106 marr <- newArray (l,u) e
107 sequence_ [do
108 old <- unsafeRead marr i
109 unsafeWrite marr i (f old new)
110 | (i, new) <- ies]
111 return marr
112
113
114 {-# INLINE array #-}
115
116 {-| Constructs an immutable array from a pair of bounds and a list of
117 initial associations.
118
119 The bounds are specified as a pair of the lowest and highest bounds in
120 the array respectively. For example, a one-origin vector of length 10
121 has bounds (1,10), and a one-origin 10 by 10 matrix has bounds
122 ((1,1),(10,10)).
123
124 An association is a pair of the form @(i,x)@, which defines the value of
125 the array at index @i@ to be @x@. The array is undefined if any index
126 in the list is out of bounds. If any two associations in the list have
127 the same index, the value at that index is implementation-dependent.
128 (In GHC, the last value specified for that index is used.
129 Other implementations will also do this for unboxed arrays, but Haskell
130 98 requires that for 'Array' the value at such indices is bottom.)
131
132 Because the indices must be checked for these errors, 'array' is
133 strict in the bounds argument and in the indices of the association
134 list. Whether @array@ is strict or non-strict in the elements depends
135 on the array type: 'Data.Array.Array' is a non-strict array type, but
136 all of the 'Data.Array.Unboxed.UArray' arrays are strict. Thus in a
137 non-strict array, recurrences such as the following are possible:
138
139 > a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i \<- [2..100]])
140
141 Not every index within the bounds of the array need appear in the
142 association list, but the values associated with indices that do not
143 appear will be undefined.
144
145 If, in any dimension, the lower bound is greater than the upper bound,
146 then the array is legal, but empty. Indexing an empty array always
147 gives an array-bounds error, but 'bounds' still yields the bounds with
148 which the array was constructed.
149 -}
150 array :: (IArray a e, Ix i)
151 => (i,i) -- ^ bounds of the array: (lowest,highest)
152 -> [(i, e)] -- ^ list of associations
153 -> a i e
154 array (l,u) ies = unsafeArray (l,u) [(index (l,u) i, e) | (i, e) <- ies]
155
156 -- Since unsafeFreeze is not guaranteed to be only a cast, we will
157 -- use unsafeArray and zip instead of a specialized loop to implement
158 -- listArray, unlike Array.listArray, even though it generates some
159 -- unnecessary heap allocation. Will use the loop only when we have
160 -- fast unsafeFreeze, namely for Array and UArray (well, they cover
161 -- almost all cases).
162
163 {-# INLINE listArray #-}
164
165 -- | Constructs an immutable array from a list of initial elements.
166 -- The list gives the elements of the array in ascending order
167 -- beginning with the lowest index.
168 listArray :: (IArray a e, Ix i) => (i,i) -> [e] -> a i e
169 listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es)
170
171 {-# INLINE listArrayST #-}
172 listArrayST :: Ix i => (i,i) -> [e] -> ST s (STArray s i e)
173 listArrayST (l,u) es = do
174 marr <- newArray_ (l,u)
175 let n = rangeSize (l,u)
176 let fillFromList i xs | i == n = return ()
177 | otherwise = case xs of
178 [] -> return ()
179 y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys
180 fillFromList 0 es
181 return marr
182
183 {-# RULES
184 "listArray/Array" listArray =
185 \lu es -> runST (listArrayST lu es >>= ArrST.unsafeFreezeSTArray)
186 #-}
187
188 {-# INLINE listUArrayST #-}
189 listUArrayST :: (MArray (STUArray s) e (ST s), Ix i)
190 => (i,i) -> [e] -> ST s (STUArray s i e)
191 listUArrayST (l,u) es = do
192 marr <- newArray_ (l,u)
193 let n = rangeSize (l,u)
194 let fillFromList i xs | i == n = return ()
195 | otherwise = case xs of
196 [] -> return ()
197 y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys
198 fillFromList 0 es
199 return marr
200
201 -- I don't know how to write a single rule for listUArrayST, because
202 -- the type looks like constrained over 's', which runST doesn't
203 -- like. In fact all MArray (STUArray s) instances are polymorphic
204 -- wrt. 's', but runST can't know that.
205
206 -- I would like to write a rule for listUArrayST (or listArray or
207 -- whatever) applied to unpackCString#. Unfortunately unpackCString#
208 -- calls seem to be floated out, then floated back into the middle
209 -- of listUArrayST, so I was not able to do this.
210
211 {-# RULES
212 "listArray/UArray/Bool" listArray = \lu (es :: [Bool]) ->
213 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
214 "listArray/UArray/Char" listArray = \lu (es :: [Char]) ->
215 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
216 "listArray/UArray/Int" listArray = \lu (es :: [Int]) ->
217 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
218 "listArray/UArray/Word" listArray = \lu (es :: [Word]) ->
219 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
220 "listArray/UArray/Ptr" listArray = \lu (es :: [Ptr a]) ->
221 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
222 "listArray/UArray/FunPtr" listArray = \lu (es :: [FunPtr a]) ->
223 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
224 "listArray/UArray/Float" listArray = \lu (es :: [Float]) ->
225 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
226 "listArray/UArray/Double" listArray = \lu (es :: [Double]) ->
227 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
228 "listArray/UArray/StablePtr" listArray = \lu (es :: [StablePtr a]) ->
229 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
230 "listArray/UArray/Int8" listArray = \lu (es :: [Int8]) ->
231 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
232 "listArray/UArray/Int16" listArray = \lu (es :: [Int16]) ->
233 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
234 "listArray/UArray/Int32" listArray = \lu (es :: [Int32]) ->
235 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
236 "listArray/UArray/Int64" listArray = \lu (es :: [Int64]) ->
237 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
238 "listArray/UArray/Word8" listArray = \lu (es :: [Word8]) ->
239 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
240 "listArray/UArray/Word16" listArray = \lu (es :: [Word16]) ->
241 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
242 "listArray/UArray/Word32" listArray = \lu (es :: [Word32]) ->
243 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
244 "listArray/UArray/Word64" listArray = \lu (es :: [Word64]) ->
245 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
246 #-}
247
248 {-# INLINE (!) #-}
249 -- | Returns the element of an immutable array at the specified index.
250 (!) :: (IArray a e, Ix i) => a i e -> i -> e
251 arr ! i = case bounds arr of (l,u) -> unsafeAt arr (index (l,u) i)
252
253 {-# INLINE indices #-}
254 -- | Returns a list of all the valid indices in an array.
255 indices :: (HasBounds a, Ix i) => a i e -> [i]
256 indices arr = case bounds arr of (l,u) -> range (l,u)
257
258 {-# INLINE elems #-}
259 -- | Returns a list of all the elements of an array, in the same order
260 -- as their indices.
261 elems :: (IArray a e, Ix i) => a i e -> [e]
262 elems arr = case bounds arr of
263 (l,u) -> [unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]]
264
265 {-# INLINE assocs #-}
266 -- | Returns the contents of an array as a list of associations.
267 assocs :: (IArray a e, Ix i) => a i e -> [(i, e)]
268 assocs arr = case bounds arr of
269 (l,u) -> [(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)]
270
271 {-# INLINE accumArray #-}
272
273 {-|
274 Constructs an immutable array from a list of associations. Unlike
275 'array', the same index is allowed to occur multiple times in the list
276 of associations; an /accumulating function/ is used to combine the
277 values of elements with the same index.
278
279 For example, given a list of values of some index type, hist produces
280 a histogram of the number of occurrences of each index within a
281 specified range:
282
283 > hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b
284 > hist bnds is = accumArray (+) 0 bnds [(i, 1) | i\<-is, inRange bnds i]
285 -}
286 accumArray :: (IArray a e, Ix i)
287 => (e -> e' -> e) -- ^ An accumulating function
288 -> e -- ^ A default element
289 -> (i,i) -- ^ The bounds of the array
290 -> [(i, e')] -- ^ List of associations
291 -> a i e -- ^ Returns: the array
292 accumArray f init (l,u) ies =
293 unsafeAccumArray f init (l,u) [(index (l,u) i, e) | (i, e) <- ies]
294
295 {-# INLINE (//) #-}
296 {-|
297 Takes an array and a list of pairs and returns an array identical to
298 the left argument except that it has been updated by the associations
299 in the right argument. For example, if m is a 1-origin, n by n matrix,
300 then @m\/\/[((i,i), 0) | i \<- [1..n]]@ is the same matrix, except with
301 the diagonal zeroed.
302
303 As with the 'array' function, if any two associations in the list have
304 the same index, the value at that index is implementation-dependent.
305 (In GHC, the last value specified for that index is used.
306 Other implementations will also do this for unboxed arrays, but Haskell
307 98 requires that for 'Array' the value at such indices is bottom.)
308
309 For most array types, this operation is O(/n/) where /n/ is the size
310 of the array. However, the 'Data.Array.Diff.DiffArray' type provides
311 this operation with complexity linear in the number of updates.
312 -}
313 (//) :: (IArray a e, Ix i) => a i e -> [(i, e)] -> a i e
314 arr // ies = case bounds arr of
315 (l,u) -> unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies]
316
317 {-# INLINE accum #-}
318 {-|
319 @accum f@ takes an array and an association list and accumulates pairs
320 from the list into the array with the accumulating function @f@. Thus
321 'accumArray' can be defined using 'accum':
322
323 > accumArray f z b = accum f (array b [(i, z) | i \<- range b])
324 -}
325 accum :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(i, e')] -> a i e
326 accum f arr ies = case bounds arr of
327 (l,u) -> unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies]
328
329 {-# INLINE amap #-}
330 -- | Returns a new array derived from the original array by applying a
331 -- function to each of the elements.
332 amap :: (IArray a e', IArray a e, Ix i) => (e' -> e) -> a i e' -> a i e
333 amap f arr = case bounds arr of
334 (l,u) -> unsafeArray (l,u) [(i, f (unsafeAt arr i)) |
335 i <- [0 .. rangeSize (l,u) - 1]]
336 {-# INLINE ixmap #-}
337 -- | Returns a new array derived from the original array by applying a
338 -- function to each of the indices.
339 ixmap :: (IArray a e, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> a i e
340 ixmap (l,u) f arr =
341 unsafeArray (l,u) [(unsafeIndex (l,u) i, arr ! f i) | i <- range (l,u)]
342
343 -----------------------------------------------------------------------------
344 -- Normal polymorphic arrays
345
346 instance HasBounds Arr.Array where
347 {-# INLINE bounds #-}
348 bounds = Arr.bounds
349
350 instance IArray Arr.Array e where
351 {-# INLINE unsafeArray #-}
352 unsafeArray = Arr.unsafeArray
353 {-# INLINE unsafeAt #-}
354 unsafeAt = Arr.unsafeAt
355 {-# INLINE unsafeReplace #-}
356 unsafeReplace = Arr.unsafeReplace
357 {-# INLINE unsafeAccum #-}
358 unsafeAccum = Arr.unsafeAccum
359 {-# INLINE unsafeAccumArray #-}
360 unsafeAccumArray = Arr.unsafeAccumArray
361
362 -----------------------------------------------------------------------------
363 -- Flat unboxed arrays
364
365 -- | Arrays with unboxed elements. Instances of 'IArray' are provided
366 -- for 'UArray' with certain element types ('Int', 'Float', 'Char',
367 -- etc.; see the 'UArray' class for a full list).
368 --
369 -- A 'UArray' will generally be more efficient (in terms of both time
370 -- and space) than the equivalent 'Data.Array.Array' with the same
371 -- element type. However, 'UArray' is strict in its elements - so
372 -- don\'t use 'UArray' if you require the non-strictness that
373 -- 'Data.Array.Array' provides.
374 --
375 -- Because the @IArray@ interface provides operations overloaded on
376 -- the type of the array, it should be possible to just change the
377 -- array type being used by a program from say @Array@ to @UArray@ to
378 -- get the benefits of unboxed arrays (don\'t forget to import
379 -- "Data.Array.Unboxed" instead of "Data.Array").
380 --
381 #ifdef __GLASGOW_HASKELL__
382 data UArray i e = UArray !i !i ByteArray#
383 #endif
384 #ifdef __HUGS__
385 data UArray i e = UArray !i !i !ByteArray
386 #endif
387
388 INSTANCE_TYPEABLE2(UArray,uArrayTc,"UArray")
389
390 instance HasBounds UArray where
391 {-# INLINE bounds #-}
392 bounds (UArray l u _) = (l,u)
393
394 {-# INLINE unsafeArrayUArray #-}
395 unsafeArrayUArray :: (MArray (STUArray s) e (ST s), Ix i)
396 => (i,i) -> [(Int, e)] -> e -> ST s (UArray i e)
397 unsafeArrayUArray (l,u) ies default_elem = do
398 marr <- newArray (l,u) default_elem
399 sequence_ [unsafeWrite marr i e | (i, e) <- ies]
400 unsafeFreezeSTUArray marr
401
402 #ifdef __GLASGOW_HASKELL__
403 {-# INLINE unsafeFreezeSTUArray #-}
404 unsafeFreezeSTUArray :: STUArray s i e -> ST s (UArray i e)
405 unsafeFreezeSTUArray (STUArray l u marr#) = ST $ \s1# ->
406 case unsafeFreezeByteArray# marr# s1# of { (# s2#, arr# #) ->
407 (# s2#, UArray l u arr# #) }
408 #endif
409
410 #ifdef __HUGS__
411 unsafeFreezeSTUArray :: STUArray s i e -> ST s (UArray i e)
412 unsafeFreezeSTUArray (STUArray l u marr) = do
413 arr <- unsafeFreezeMutableByteArray marr
414 return (UArray l u arr)
415 #endif
416
417 {-# INLINE unsafeReplaceUArray #-}
418 unsafeReplaceUArray :: (MArray (STUArray s) e (ST s), Ix i)
419 => UArray i e -> [(Int, e)] -> ST s (UArray i e)
420 unsafeReplaceUArray arr ies = do
421 marr <- thawSTUArray arr
422 sequence_ [unsafeWrite marr i e | (i, e) <- ies]
423 unsafeFreezeSTUArray marr
424
425 {-# INLINE unsafeAccumUArray #-}
426 unsafeAccumUArray :: (MArray (STUArray s) e (ST s), Ix i)
427 => (e -> e' -> e) -> UArray i e -> [(Int, e')] -> ST s (UArray i e)
428 unsafeAccumUArray f arr ies = do
429 marr <- thawSTUArray arr
430 sequence_ [do
431 old <- unsafeRead marr i
432 unsafeWrite marr i (f old new)
433 | (i, new) <- ies]
434 unsafeFreezeSTUArray marr
435
436 {-# INLINE unsafeAccumArrayUArray #-}
437 unsafeAccumArrayUArray :: (MArray (STUArray s) e (ST s), Ix i)
438 => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (UArray i e)
439 unsafeAccumArrayUArray f init (l,u) ies = do
440 marr <- newArray (l,u) init
441 sequence_ [do
442 old <- unsafeRead marr i
443 unsafeWrite marr i (f old new)
444 | (i, new) <- ies]
445 unsafeFreezeSTUArray marr
446
447 {-# INLINE eqUArray #-}
448 eqUArray :: (IArray UArray e, Ix i, Eq e) => UArray i e -> UArray i e -> Bool
449 eqUArray arr1@(UArray l1 u1 _) arr2@(UArray l2 u2 _) =
450 if rangeSize (l1,u1) == 0 then rangeSize (l2,u2) == 0 else
451 l1 == l2 && u1 == u2 &&
452 and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. rangeSize (l1,u1) - 1]]
453
454 {-# INLINE cmpUArray #-}
455 cmpUArray :: (IArray UArray e, Ix i, Ord e) => UArray i e -> UArray i e -> Ordering
456 cmpUArray arr1 arr2 = compare (assocs arr1) (assocs arr2)
457
458 {-# INLINE cmpIntUArray #-}
459 cmpIntUArray :: (IArray UArray e, Ord e) => UArray Int e -> UArray Int e -> Ordering
460 cmpIntUArray arr1@(UArray l1 u1 _) arr2@(UArray l2 u2 _) =
461 if rangeSize (l1,u1) == 0 then if rangeSize (l2,u2) == 0 then EQ else LT else
462 if rangeSize (l2,u2) == 0 then GT else
463 case compare l1 l2 of
464 EQ -> foldr cmp (compare u1 u2) [0 .. rangeSize (l1, min u1 u2) - 1]
465 other -> other
466 where
467 cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of
468 EQ -> rest
469 other -> other
470
471 {-# RULES "cmpUArray/Int" cmpUArray = cmpIntUArray #-}
472
473 -----------------------------------------------------------------------------
474 -- Showing IArrays
475
476 {-# SPECIALISE
477 showsIArray :: (IArray UArray e, Ix i, Show i, Show e) =>
478 Int -> UArray i e -> ShowS
479 #-}
480
481 showsIArray :: (IArray a e, Ix i, Show i, Show e) => Int -> a i e -> ShowS
482 showsIArray p a =
483 showParen (p > 9) $
484 showString "array " .
485 shows (bounds a) .
486 showChar ' ' .
487 shows (assocs a)
488
489 -----------------------------------------------------------------------------
490 -- Flat unboxed arrays: instances
491
492 #ifdef __HUGS__
493 unsafeAtBArray :: Storable e => UArray i e -> Int -> e
494 unsafeAtBArray (UArray _ _ arr) = readByteArray arr
495 #endif
496
497 instance IArray UArray Bool where
498 {-# INLINE unsafeArray #-}
499 unsafeArray lu ies = runST (unsafeArrayUArray lu ies False)
500 #ifdef __GLASGOW_HASKELL__
501 {-# INLINE unsafeAt #-}
502 unsafeAt (UArray _ _ arr#) (I# i#) =
503 (indexWordArray# arr# (bOOL_INDEX i#) `and#` bOOL_BIT i#)
504 `neWord#` int2Word# 0#
505 #endif
506 #ifdef __HUGS__
507 unsafeAt (UArray _ _ arr) i =
508 testBit (readByteArray arr (bOOL_INDEX i)::BitSet) (bOOL_SUBINDEX i)
509 #endif
510 {-# INLINE unsafeReplace #-}
511 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
512 {-# INLINE unsafeAccum #-}
513 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
514 {-# INLINE unsafeAccumArray #-}
515 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
516
517 instance IArray UArray Char where
518 {-# INLINE unsafeArray #-}
519 unsafeArray lu ies = runST (unsafeArrayUArray lu ies '\0')
520 {-# INLINE unsafeAt #-}
521 #ifdef __GLASGOW_HASKELL__
522 unsafeAt (UArray _ _ arr#) (I# i#) = C# (indexWideCharArray# arr# i#)
523 #endif
524 #ifdef __HUGS__
525 unsafeAt = unsafeAtBArray
526 #endif
527 {-# INLINE unsafeReplace #-}
528 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
529 {-# INLINE unsafeAccum #-}
530 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
531 {-# INLINE unsafeAccumArray #-}
532 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
533
534 instance IArray UArray Int where
535 {-# INLINE unsafeArray #-}
536 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
537 #ifdef __GLASGOW_HASKELL__
538 {-# INLINE unsafeAt #-}
539 unsafeAt (UArray _ _ arr#) (I# i#) = I# (indexIntArray# arr# i#)
540 #endif
541 #ifdef __HUGS__
542 unsafeAt = unsafeAtBArray
543 #endif
544 {-# INLINE unsafeReplace #-}
545 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
546 {-# INLINE unsafeAccum #-}
547 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
548 {-# INLINE unsafeAccumArray #-}
549 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
550
551 instance IArray UArray Word where
552 {-# INLINE unsafeArray #-}
553 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
554 #ifdef __GLASGOW_HASKELL__
555 {-# INLINE unsafeAt #-}
556 unsafeAt (UArray _ _ arr#) (I# i#) = W# (indexWordArray# arr# i#)
557 #endif
558 #ifdef __HUGS__
559 unsafeAt = unsafeAtBArray
560 #endif
561 {-# INLINE unsafeReplace #-}
562 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
563 {-# INLINE unsafeAccum #-}
564 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
565 {-# INLINE unsafeAccumArray #-}
566 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
567
568 instance IArray UArray (Ptr a) where
569 {-# INLINE unsafeArray #-}
570 unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullPtr)
571 {-# INLINE unsafeAt #-}
572 #ifdef __GLASGOW_HASKELL__
573 unsafeAt (UArray _ _ arr#) (I# i#) = Ptr (indexAddrArray# arr# i#)
574 #endif
575 #ifdef __HUGS__
576 unsafeAt = unsafeAtBArray
577 #endif
578 {-# INLINE unsafeReplace #-}
579 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
580 {-# INLINE unsafeAccum #-}
581 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
582 {-# INLINE unsafeAccumArray #-}
583 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
584
585 instance IArray UArray (FunPtr a) where
586 {-# INLINE unsafeArray #-}
587 unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullFunPtr)
588 #ifdef __GLASGOW_HASKELL__
589 {-# INLINE unsafeAt #-}
590 unsafeAt (UArray _ _ arr#) (I# i#) = FunPtr (indexAddrArray# arr# i#)
591 #endif
592 #ifdef __HUGS__
593 unsafeAt = unsafeAtBArray
594 #endif
595 {-# INLINE unsafeReplace #-}
596 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
597 {-# INLINE unsafeAccum #-}
598 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
599 {-# INLINE unsafeAccumArray #-}
600 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
601
602 instance IArray UArray Float where
603 {-# INLINE unsafeArray #-}
604 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
605 #ifdef __GLASGOW_HASKELL__
606 {-# INLINE unsafeAt #-}
607 unsafeAt (UArray _ _ arr#) (I# i#) = F# (indexFloatArray# arr# i#)
608 #endif
609 #ifdef __HUGS__
610 unsafeAt = unsafeAtBArray
611 #endif
612 {-# INLINE unsafeReplace #-}
613 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
614 {-# INLINE unsafeAccum #-}
615 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
616 {-# INLINE unsafeAccumArray #-}
617 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
618
619 instance IArray UArray Double where
620 {-# INLINE unsafeArray #-}
621 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
622 #ifdef __GLASGOW_HASKELL__
623 {-# INLINE unsafeAt #-}
624 unsafeAt (UArray _ _ arr#) (I# i#) = D# (indexDoubleArray# arr# i#)
625 #endif
626 #ifdef __HUGS__
627 unsafeAt = unsafeAtBArray
628 #endif
629 {-# INLINE unsafeReplace #-}
630 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
631 {-# INLINE unsafeAccum #-}
632 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
633 {-# INLINE unsafeAccumArray #-}
634 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
635
636 instance IArray UArray (StablePtr a) where
637 {-# INLINE unsafeArray #-}
638 unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullStablePtr)
639 #ifdef __GLASGOW_HASKELL__
640 {-# INLINE unsafeAt #-}
641 unsafeAt (UArray _ _ arr#) (I# i#) = StablePtr (indexStablePtrArray# arr# i#)
642 #endif
643 #ifdef __HUGS__
644 unsafeAt = unsafeAtBArray
645 #endif
646 {-# INLINE unsafeReplace #-}
647 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
648 {-# INLINE unsafeAccum #-}
649 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
650 {-# INLINE unsafeAccumArray #-}
651 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
652
653 -- bogus StablePtr value for initialising a UArray of StablePtr.
654 #ifdef __GLASGOW_HASKELL__
655 nullStablePtr = StablePtr (unsafeCoerce# 0#)
656 #endif
657 #ifdef __HUGS__
658 nullStablePtr = castPtrToStablePtr nullPtr
659 #endif
660
661 instance IArray UArray Int8 where
662 {-# INLINE unsafeArray #-}
663 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
664 #ifdef __GLASGOW_HASKELL__
665 {-# INLINE unsafeAt #-}
666 unsafeAt (UArray _ _ arr#) (I# i#) = I8# (indexInt8Array# arr# i#)
667 #endif
668 #ifdef __HUGS__
669 unsafeAt = unsafeAtBArray
670 #endif
671 {-# INLINE unsafeReplace #-}
672 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
673 {-# INLINE unsafeAccum #-}
674 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
675 {-# INLINE unsafeAccumArray #-}
676 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
677
678 instance IArray UArray Int16 where
679 {-# INLINE unsafeArray #-}
680 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
681 #ifdef __GLASGOW_HASKELL__
682 {-# INLINE unsafeAt #-}
683 unsafeAt (UArray _ _ arr#) (I# i#) = I16# (indexInt16Array# arr# i#)
684 #endif
685 #ifdef __HUGS__
686 unsafeAt = unsafeAtBArray
687 #endif
688 {-# INLINE unsafeReplace #-}
689 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
690 {-# INLINE unsafeAccum #-}
691 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
692 {-# INLINE unsafeAccumArray #-}
693 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
694
695 instance IArray UArray Int32 where
696 {-# INLINE unsafeArray #-}
697 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
698 #ifdef __GLASGOW_HASKELL__
699 {-# INLINE unsafeAt #-}
700 unsafeAt (UArray _ _ arr#) (I# i#) = I32# (indexInt32Array# arr# i#)
701 #endif
702 #ifdef __HUGS__
703 unsafeAt = unsafeAtBArray
704 #endif
705 {-# INLINE unsafeReplace #-}
706 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
707 {-# INLINE unsafeAccum #-}
708 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
709 {-# INLINE unsafeAccumArray #-}
710 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
711
712 instance IArray UArray Int64 where
713 {-# INLINE unsafeArray #-}
714 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
715 #ifdef __GLASGOW_HASKELL__
716 {-# INLINE unsafeAt #-}
717 unsafeAt (UArray _ _ arr#) (I# i#) = I64# (indexInt64Array# arr# i#)
718 #endif
719 #ifdef __HUGS__
720 unsafeAt = unsafeAtBArray
721 #endif
722 {-# INLINE unsafeReplace #-}
723 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
724 {-# INLINE unsafeAccum #-}
725 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
726 {-# INLINE unsafeAccumArray #-}
727 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
728
729 instance IArray UArray Word8 where
730 {-# INLINE unsafeArray #-}
731 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
732 #ifdef __GLASGOW_HASKELL__
733 {-# INLINE unsafeAt #-}
734 unsafeAt (UArray _ _ arr#) (I# i#) = W8# (indexWord8Array# arr# i#)
735 #endif
736 #ifdef __HUGS__
737 unsafeAt = unsafeAtBArray
738 #endif
739 {-# INLINE unsafeReplace #-}
740 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
741 {-# INLINE unsafeAccum #-}
742 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
743 {-# INLINE unsafeAccumArray #-}
744 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
745
746 instance IArray UArray Word16 where
747 {-# INLINE unsafeArray #-}
748 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
749 #ifdef __GLASGOW_HASKELL__
750 {-# INLINE unsafeAt #-}
751 unsafeAt (UArray _ _ arr#) (I# i#) = W16# (indexWord16Array# arr# i#)
752 #endif
753 #ifdef __HUGS__
754 unsafeAt = unsafeAtBArray
755 #endif
756 {-# INLINE unsafeReplace #-}
757 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
758 {-# INLINE unsafeAccum #-}
759 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
760 {-# INLINE unsafeAccumArray #-}
761 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
762
763 instance IArray UArray Word32 where
764 {-# INLINE unsafeArray #-}
765 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
766 #ifdef __GLASGOW_HASKELL__
767 {-# INLINE unsafeAt #-}
768 unsafeAt (UArray _ _ arr#) (I# i#) = W32# (indexWord32Array# arr# i#)
769 #endif
770 #ifdef __HUGS__
771 unsafeAt = unsafeAtBArray
772 #endif
773 {-# INLINE unsafeReplace #-}
774 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
775 {-# INLINE unsafeAccum #-}
776 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
777 {-# INLINE unsafeAccumArray #-}
778 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
779
780 instance IArray UArray Word64 where
781 {-# INLINE unsafeArray #-}
782 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
783 #ifdef __GLASGOW_HASKELL__
784 {-# INLINE unsafeAt #-}
785 unsafeAt (UArray _ _ arr#) (I# i#) = W64# (indexWord64Array# arr# i#)
786 #endif
787 #ifdef __HUGS__
788 unsafeAt = unsafeAtBArray
789 #endif
790 {-# INLINE unsafeReplace #-}
791 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
792 {-# INLINE unsafeAccum #-}
793 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
794 {-# INLINE unsafeAccumArray #-}
795 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
796
797 instance Ix ix => Eq (UArray ix Bool) where
798 (==) = eqUArray
799
800 instance Ix ix => Eq (UArray ix Char) where
801 (==) = eqUArray
802
803 instance Ix ix => Eq (UArray ix Int) where
804 (==) = eqUArray
805
806 instance Ix ix => Eq (UArray ix Word) where
807 (==) = eqUArray
808
809 instance Ix ix => Eq (UArray ix (Ptr a)) where
810 (==) = eqUArray
811
812 instance Ix ix => Eq (UArray ix (FunPtr a)) where
813 (==) = eqUArray
814
815 instance Ix ix => Eq (UArray ix Float) where
816 (==) = eqUArray
817
818 instance Ix ix => Eq (UArray ix Double) where
819 (==) = eqUArray
820
821 #ifdef __GLASGOW_HASKELL__
822 instance Ix ix => Eq (UArray ix (StablePtr a)) where
823 (==) = eqUArray
824 #endif
825
826 instance Ix ix => Eq (UArray ix Int8) where
827 (==) = eqUArray
828
829 instance Ix ix => Eq (UArray ix Int16) where
830 (==) = eqUArray
831
832 instance Ix ix => Eq (UArray ix Int32) where
833 (==) = eqUArray
834
835 instance Ix ix => Eq (UArray ix Int64) where
836 (==) = eqUArray
837
838 instance Ix ix => Eq (UArray ix Word8) where
839 (==) = eqUArray
840
841 instance Ix ix => Eq (UArray ix Word16) where
842 (==) = eqUArray
843
844 instance Ix ix => Eq (UArray ix Word32) where
845 (==) = eqUArray
846
847 instance Ix ix => Eq (UArray ix Word64) where
848 (==) = eqUArray
849
850 instance Ix ix => Ord (UArray ix Bool) where
851 compare = cmpUArray
852
853 instance Ix ix => Ord (UArray ix Char) where
854 compare = cmpUArray
855
856 instance Ix ix => Ord (UArray ix Int) where
857 compare = cmpUArray
858
859 instance Ix ix => Ord (UArray ix Word) where
860 compare = cmpUArray
861
862 instance Ix ix => Ord (UArray ix (Ptr a)) where
863 compare = cmpUArray
864
865 instance Ix ix => Ord (UArray ix (FunPtr a)) where
866 compare = cmpUArray
867
868 instance Ix ix => Ord (UArray ix Float) where
869 compare = cmpUArray
870
871 instance Ix ix => Ord (UArray ix Double) where
872 compare = cmpUArray
873
874 instance Ix ix => Ord (UArray ix Int8) where
875 compare = cmpUArray
876
877 instance Ix ix => Ord (UArray ix Int16) where
878 compare = cmpUArray
879
880 instance Ix ix => Ord (UArray ix Int32) where
881 compare = cmpUArray
882
883 instance Ix ix => Ord (UArray ix Int64) where
884 compare = cmpUArray
885
886 instance Ix ix => Ord (UArray ix Word8) where
887 compare = cmpUArray
888
889 instance Ix ix => Ord (UArray ix Word16) where
890 compare = cmpUArray
891
892 instance Ix ix => Ord (UArray ix Word32) where
893 compare = cmpUArray
894
895 instance Ix ix => Ord (UArray ix Word64) where
896 compare = cmpUArray
897
898 instance (Ix ix, Show ix) => Show (UArray ix Bool) where
899 showsPrec = showsIArray
900
901 instance (Ix ix, Show ix) => Show (UArray ix Char) where
902 showsPrec = showsIArray
903
904 instance (Ix ix, Show ix) => Show (UArray ix Int) where
905 showsPrec = showsIArray
906
907 instance (Ix ix, Show ix) => Show (UArray ix Word) where
908 showsPrec = showsIArray
909
910 instance (Ix ix, Show ix) => Show (UArray ix Float) where
911 showsPrec = showsIArray
912
913 instance (Ix ix, Show ix) => Show (UArray ix Double) where
914 showsPrec = showsIArray
915
916 instance (Ix ix, Show ix) => Show (UArray ix Int8) where
917 showsPrec = showsIArray
918
919 instance (Ix ix, Show ix) => Show (UArray ix Int16) where
920 showsPrec = showsIArray
921
922 instance (Ix ix, Show ix) => Show (UArray ix Int32) where
923 showsPrec = showsIArray
924
925 instance (Ix ix, Show ix) => Show (UArray ix Int64) where
926 showsPrec = showsIArray
927
928 instance (Ix ix, Show ix) => Show (UArray ix Word8) where
929 showsPrec = showsIArray
930
931 instance (Ix ix, Show ix) => Show (UArray ix Word16) where
932 showsPrec = showsIArray
933
934 instance (Ix ix, Show ix) => Show (UArray ix Word32) where
935 showsPrec = showsIArray
936
937 instance (Ix ix, Show ix) => Show (UArray ix Word64) where
938 showsPrec = showsIArray
939
940 -----------------------------------------------------------------------------
941 -- Mutable arrays
942
943 {-# NOINLINE arrEleBottom #-}
944 arrEleBottom :: a
945 arrEleBottom = error "MArray: undefined array element"
946
947 {-| Class of mutable array types.
948
949 An array type has the form @(a i e)@ where @a@ is the array type
950 constructor (kind @* -> * -> *@), @i@ is the index type (a member of
951 the class 'Ix'), and @e@ is the element type.
952
953 The @MArray@ class is parameterised over both @a@ and @e@ (so that
954 instances specialised to certain element types can be defined, in the
955 same way as for 'IArray'), and also over the type of the monad, @m@,
956 in which the mutable array will be manipulated.
957 -}
958 class (HasBounds a, Monad m) => MArray a e m where
959
960 -- | Builds a new array, with every element initialised to the supplied
961 -- value.
962 newArray :: Ix i => (i,i) -> e -> m (a i e)
963
964 -- | Builds a new array, with every element initialised to undefined.
965 newArray_ :: Ix i => (i,i) -> m (a i e)
966
967 unsafeRead :: Ix i => a i e -> Int -> m e
968 unsafeWrite :: Ix i => a i e -> Int -> e -> m ()
969
970 {-# INLINE newArray #-}
971 -- The INLINE is crucial, because until we know at least which monad
972 -- we are in, the code below allocates like crazy. So inline it,
973 -- in the hope that the context will know the monad.
974 newArray (l,u) init = do
975 marr <- newArray_ (l,u)
976 sequence_ [unsafeWrite marr i init | i <- [0 .. rangeSize (l,u) - 1]]
977 return marr
978
979 newArray_ (l,u) = newArray (l,u) arrEleBottom
980
981 -- newArray takes an initialiser which all elements of
982 -- the newly created array are initialised to. newArray_ takes
983 -- no initialiser, it is assumed that the array is initialised with
984 -- "undefined" values.
985
986 -- why not omit newArray_? Because in the unboxed array case we would
987 -- like to omit the initialisation altogether if possible. We can't do
988 -- this for boxed arrays, because the elements must all have valid values
989 -- at all times in case of garbage collection.
990
991 -- why not omit newArray? Because in the boxed case, we can omit the
992 -- default initialisation with undefined values if we *do* know the
993 -- initial value and it is constant for all elements.
994
995 {-# INLINE newListArray #-}
996 -- | Constructs a mutable array from a list of initial elements.
997 -- The list gives the elements of the array in ascending order
998 -- beginning with the lowest index.
999 newListArray :: (MArray a e m, Ix i) => (i,i) -> [e] -> m (a i e)
1000 newListArray (l,u) es = do
1001 marr <- newArray_ (l,u)
1002 let n = rangeSize (l,u)
1003 let fillFromList i xs | i == n = return ()
1004 | otherwise = case xs of
1005 [] -> return ()
1006 y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys
1007 fillFromList 0 es
1008 return marr
1009
1010 {-# INLINE readArray #-}
1011 -- | Read an element from a mutable array
1012 readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
1013 readArray marr i = case bounds marr of
1014 (l,u) -> unsafeRead marr (index (l,u) i)
1015
1016 {-# INLINE writeArray #-}
1017 -- | Write an element in a mutable array
1018 writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
1019 writeArray marr i e = case bounds marr of
1020 (l,u) -> unsafeWrite marr (index (l,u) i) e
1021
1022 {-# INLINE getElems #-}
1023 -- | Return a list of all the elements of a mutable array
1024 getElems :: (MArray a e m, Ix i) => a i e -> m [e]
1025 getElems marr = case bounds marr of
1026 (l,u) -> sequence [unsafeRead marr i | i <- [0 .. rangeSize (l,u) - 1]]
1027
1028 {-# INLINE getAssocs #-}
1029 -- | Return a list of all the associations of a mutable array, in
1030 -- index order.
1031 getAssocs :: (MArray a e m, Ix i) => a i e -> m [(i, e)]
1032 getAssocs marr = case bounds marr of
1033 (l,u) -> sequence [do e <- unsafeRead marr (index (l,u) i); return (i,e)
1034 | i <- range (l,u)]
1035
1036 {-# INLINE mapArray #-}
1037 -- | Constructs a new array derived from the original array by applying a
1038 -- function to each of the elements.
1039 mapArray :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e)
1040 mapArray f marr = case bounds marr of
1041 (l,u) -> do
1042 marr' <- newArray_ (l,u)
1043 sequence_ [do
1044 e <- unsafeRead marr i
1045 unsafeWrite marr' i (f e)
1046 | i <- [0 .. rangeSize (l,u) - 1]]
1047 return marr'
1048
1049 {-# INLINE mapIndices #-}
1050 -- | Constructs a new array derived from the original array by applying a
1051 -- function to each of the indices.
1052 mapIndices :: (MArray a e m, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> m (a i e)
1053 mapIndices (l,u) f marr = do
1054 marr' <- newArray_ (l,u)
1055 sequence_ [do
1056 e <- readArray marr (f i)
1057 unsafeWrite marr' (unsafeIndex (l,u) i) e
1058 | i <- range (l,u)]
1059 return marr'
1060
1061 -----------------------------------------------------------------------------
1062 -- Polymorphic non-strict mutable arrays (ST monad)
1063
1064 instance HasBounds (STArray s) where
1065 {-# INLINE bounds #-}
1066 bounds = ArrST.boundsSTArray
1067
1068 instance MArray (STArray s) e (ST s) where
1069 {-# INLINE newArray #-}
1070 newArray = ArrST.newSTArray
1071 {-# INLINE unsafeRead #-}
1072 unsafeRead = ArrST.unsafeReadSTArray
1073 {-# INLINE unsafeWrite #-}
1074 unsafeWrite = ArrST.unsafeWriteSTArray
1075
1076 instance MArray (STArray s) e (Lazy.ST s) where
1077 {-# INLINE newArray #-}
1078 newArray (l,u) e = strictToLazyST (ArrST.newSTArray (l,u) e)
1079 {-# INLINE unsafeRead #-}
1080 unsafeRead arr i = strictToLazyST (ArrST.unsafeReadSTArray arr i)
1081 {-# INLINE unsafeWrite #-}
1082 unsafeWrite arr i e = strictToLazyST (ArrST.unsafeWriteSTArray arr i e)
1083
1084 #ifdef __HUGS__
1085 INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray")
1086 #endif
1087
1088 -----------------------------------------------------------------------------
1089 -- Flat unboxed mutable arrays (ST monad)
1090
1091 -- | A mutable array with unboxed elements, that can be manipulated in
1092 -- the 'ST' monad. The type arguments are as follows:
1093 --
1094 -- * @s@: the state variable argument for the 'ST' type
1095 --
1096 -- * @i@: the index type of the array (should be an instance of @Ix@)
1097 --
1098 -- * @e@: the element type of the array. Only certain element types
1099 -- are supported.
1100 --
1101 -- An 'STUArray' will generally be more efficient (in terms of both time
1102 -- and space) than the equivalent boxed version ('STArray') with the same
1103 -- element type. However, 'STUArray' is strict in its elements - so
1104 -- don\'t use 'STUArray' if you require the non-strictness that
1105 -- 'STArray' provides.
1106 #ifdef __GLASGOW_HASKELL__
1107 data STUArray s i a = STUArray !i !i (MutableByteArray# s)
1108 #endif
1109 #ifdef __HUGS__
1110 data STUArray s i a = STUArray !i !i !(MutableByteArray s)
1111 #endif
1112
1113 INSTANCE_TYPEABLE3(STUArray,stUArrayTc,"STUArray")
1114
1115 instance HasBounds (STUArray s) where
1116 {-# INLINE bounds #-}
1117 bounds (STUArray l u _) = (l,u)
1118
1119 #ifdef __GLASGOW_HASKELL__
1120 instance MArray (STUArray s) Bool (ST s) where
1121 {-# INLINE newArray #-}
1122 newArray (l,u) init = ST $ \s1# ->
1123 case rangeSize (l,u) of { I# n# ->
1124 case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
1125 case bOOL_WORD_SCALE n# of { n'# ->
1126 let loop i# s3# | i# ==# n'# = s3#
1127 | otherwise =
1128 case writeWordArray# marr# i# e# s3# of { s4# ->
1129 loop (i# +# 1#) s4# } in
1130 case loop 0# s2# of { s3# ->
1131 (# s3#, STUArray l u marr# #) }}}}
1132 where
1133 W# e# = if init then maxBound else 0
1134 {-# INLINE newArray_ #-}
1135 newArray_ (l,u) = ST $ \s1# ->
1136 case rangeSize (l,u) of { I# n# ->
1137 case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
1138 (# s2#, STUArray l u marr# #) }}
1139 {-# INLINE unsafeRead #-}
1140 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1141 case readWordArray# marr# (bOOL_INDEX i#) s1# of { (# s2#, e# #) ->
1142 (# s2#, (e# `and#` bOOL_BIT i#) `neWord#` int2Word# 0# #) }
1143 {-# INLINE unsafeWrite #-}
1144 unsafeWrite (STUArray _ _ marr#) (I# i#) e = ST $ \s1# ->
1145 case bOOL_INDEX i# of { j# ->
1146 case readWordArray# marr# j# s1# of { (# s2#, old# #) ->
1147 case if e then old# `or#` bOOL_BIT i#
1148 else old# `and#` bOOL_NOT_BIT i# of { e# ->
1149 case writeWordArray# marr# j# e# s2# of { s3# ->
1150 (# s3#, () #) }}}}
1151
1152 instance MArray (STUArray s) Char (ST s) where
1153 {-# INLINE newArray_ #-}
1154 newArray_ (l,u) = ST $ \s1# ->
1155 case rangeSize (l,u) of { I# n# ->
1156 case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
1157 (# s2#, STUArray l u marr# #) }}
1158 {-# INLINE unsafeRead #-}
1159 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1160 case readWideCharArray# marr# i# s1# of { (# s2#, e# #) ->
1161 (# s2#, C# e# #) }
1162 {-# INLINE unsafeWrite #-}
1163 unsafeWrite (STUArray _ _ marr#) (I# i#) (C# e#) = ST $ \s1# ->
1164 case writeWideCharArray# marr# i# e# s1# of { s2# ->
1165 (# s2#, () #) }
1166
1167 instance MArray (STUArray s) Int (ST s) where
1168 {-# INLINE newArray_ #-}
1169 newArray_ (l,u) = ST $ \s1# ->
1170 case rangeSize (l,u) of { I# n# ->
1171 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1172 (# s2#, STUArray l u marr# #) }}
1173 {-# INLINE unsafeRead #-}
1174 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1175 case readIntArray# marr# i# s1# of { (# s2#, e# #) ->
1176 (# s2#, I# e# #) }
1177 {-# INLINE unsafeWrite #-}
1178 unsafeWrite (STUArray _ _ marr#) (I# i#) (I# e#) = ST $ \s1# ->
1179 case writeIntArray# marr# i# e# s1# of { s2# ->
1180 (# s2#, () #) }
1181
1182 instance MArray (STUArray s) Word (ST s) where
1183 {-# INLINE newArray_ #-}
1184 newArray_ (l,u) = ST $ \s1# ->
1185 case rangeSize (l,u) of { I# n# ->
1186 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1187 (# s2#, STUArray l u marr# #) }}
1188 {-# INLINE unsafeRead #-}
1189 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1190 case readWordArray# marr# i# s1# of { (# s2#, e# #) ->
1191 (# s2#, W# e# #) }
1192 {-# INLINE unsafeWrite #-}
1193 unsafeWrite (STUArray _ _ marr#) (I# i#) (W# e#) = ST $ \s1# ->
1194 case writeWordArray# marr# i# e# s1# of { s2# ->
1195 (# s2#, () #) }
1196
1197 instance MArray (STUArray s) (Ptr a) (ST s) where
1198 {-# INLINE newArray_ #-}
1199 newArray_ (l,u) = ST $ \s1# ->
1200 case rangeSize (l,u) of { I# n# ->
1201 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1202 (# s2#, STUArray l u marr# #) }}
1203 {-# INLINE unsafeRead #-}
1204 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1205 case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
1206 (# s2#, Ptr e# #) }
1207 {-# INLINE unsafeWrite #-}
1208 unsafeWrite (STUArray _ _ marr#) (I# i#) (Ptr e#) = ST $ \s1# ->
1209 case writeAddrArray# marr# i# e# s1# of { s2# ->
1210 (# s2#, () #) }
1211
1212 instance MArray (STUArray s) (FunPtr a) (ST s) where
1213 {-# INLINE newArray_ #-}
1214 newArray_ (l,u) = ST $ \s1# ->
1215 case rangeSize (l,u) of { I# n# ->
1216 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1217 (# s2#, STUArray l u marr# #) }}
1218 {-# INLINE unsafeRead #-}
1219 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1220 case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
1221 (# s2#, FunPtr e# #) }
1222 {-# INLINE unsafeWrite #-}
1223 unsafeWrite (STUArray _ _ marr#) (I# i#) (FunPtr e#) = ST $ \s1# ->
1224 case writeAddrArray# marr# i# e# s1# of { s2# ->
1225 (# s2#, () #) }
1226
1227 instance MArray (STUArray s) Float (ST s) where
1228 {-# INLINE newArray_ #-}
1229 newArray_ (l,u) = ST $ \s1# ->
1230 case rangeSize (l,u) of { I# n# ->
1231 case newByteArray# (fLOAT_SCALE n#) s1# of { (# s2#, marr# #) ->
1232 (# s2#, STUArray l u marr# #) }}
1233 {-# INLINE unsafeRead #-}
1234 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1235 case readFloatArray# marr# i# s1# of { (# s2#, e# #) ->
1236 (# s2#, F# e# #) }
1237 {-# INLINE unsafeWrite #-}
1238 unsafeWrite (STUArray _ _ marr#) (I# i#) (F# e#) = ST $ \s1# ->
1239 case writeFloatArray# marr# i# e# s1# of { s2# ->
1240 (# s2#, () #) }
1241
1242 instance MArray (STUArray s) Double (ST s) where
1243 {-# INLINE newArray_ #-}
1244 newArray_ (l,u) = ST $ \s1# ->
1245 case rangeSize (l,u) of { I# n# ->
1246 case newByteArray# (dOUBLE_SCALE n#) s1# of { (# s2#, marr# #) ->
1247 (# s2#, STUArray l u marr# #) }}
1248 {-# INLINE unsafeRead #-}
1249 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1250 case readDoubleArray# marr# i# s1# of { (# s2#, e# #) ->
1251 (# s2#, D# e# #) }
1252 {-# INLINE unsafeWrite #-}
1253 unsafeWrite (STUArray _ _ marr#) (I# i#) (D# e#) = ST $ \s1# ->
1254 case writeDoubleArray# marr# i# e# s1# of { s2# ->
1255 (# s2#, () #) }
1256
1257 instance MArray (STUArray s) (StablePtr a) (ST s) where
1258 {-# INLINE newArray_ #-}
1259 newArray_ (l,u) = ST $ \s1# ->
1260 case rangeSize (l,u) of { I# n# ->
1261 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1262 (# s2#, STUArray l u marr# #) }}
1263 {-# INLINE unsafeRead #-}
1264 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1265 case readStablePtrArray# marr# i# s1# of { (# s2#, e# #) ->
1266 (# s2# , StablePtr e# #) }
1267 {-# INLINE unsafeWrite #-}
1268 unsafeWrite (STUArray _ _ marr#) (I# i#) (StablePtr e#) = ST $ \s1# ->
1269 case writeStablePtrArray# marr# i# e# s1# of { s2# ->
1270 (# s2#, () #) }
1271
1272 instance MArray (STUArray s) Int8 (ST s) where
1273 {-# INLINE newArray_ #-}
1274 newArray_ (l,u) = ST $ \s1# ->
1275 case rangeSize (l,u) of { I# n# ->
1276 case newByteArray# n# s1# of { (# s2#, marr# #) ->
1277 (# s2#, STUArray l u marr# #) }}
1278 {-# INLINE unsafeRead #-}
1279 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1280 case readInt8Array# marr# i# s1# of { (# s2#, e# #) ->
1281 (# s2#, I8# e# #) }
1282 {-# INLINE unsafeWrite #-}
1283 unsafeWrite (STUArray _ _ marr#) (I# i#) (I8# e#) = ST $ \s1# ->
1284 case writeInt8Array# marr# i# e# s1# of { s2# ->
1285 (# s2#, () #) }
1286
1287 instance MArray (STUArray s) Int16 (ST s) where
1288 {-# INLINE newArray_ #-}
1289 newArray_ (l,u) = ST $ \s1# ->
1290 case rangeSize (l,u) of { I# n# ->
1291 case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) ->
1292 (# s2#, STUArray l u marr# #) }}
1293 {-# INLINE unsafeRead #-}
1294 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1295 case readInt16Array# marr# i# s1# of { (# s2#, e# #) ->
1296 (# s2#, I16# e# #) }
1297 {-# INLINE unsafeWrite #-}
1298 unsafeWrite (STUArray _ _ marr#) (I# i#) (I16# e#) = ST $ \s1# ->
1299 case writeInt16Array# marr# i# e# s1# of { s2# ->
1300 (# s2#, () #) }
1301
1302 instance MArray (STUArray s) Int32 (ST s) where
1303 {-# INLINE newArray_ #-}
1304 newArray_ (l,u) = ST $ \s1# ->
1305 case rangeSize (l,u) of { I# n# ->
1306 case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
1307 (# s2#, STUArray l u marr# #) }}
1308 {-# INLINE unsafeRead #-}
1309 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1310 case readInt32Array# marr# i# s1# of { (# s2#, e# #) ->
1311 (# s2#, I32# e# #) }
1312 {-# INLINE unsafeWrite #-}
1313 unsafeWrite (STUArray _ _ marr#) (I# i#) (I32# e#) = ST $ \s1# ->
1314 case writeInt32Array# marr# i# e# s1# of { s2# ->
1315 (# s2#, () #) }
1316
1317 instance MArray (STUArray s) Int64 (ST s) where
1318 {-# INLINE newArray_ #-}
1319 newArray_ (l,u) = ST $ \s1# ->
1320 case rangeSize (l,u) of { I# n# ->
1321 case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) ->
1322 (# s2#, STUArray l u marr# #) }}
1323 {-# INLINE unsafeRead #-}
1324 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1325 case readInt64Array# marr# i# s1# of { (# s2#, e# #) ->
1326 (# s2#, I64# e# #) }
1327 {-# INLINE unsafeWrite #-}
1328 unsafeWrite (STUArray _ _ marr#) (I# i#) (I64# e#) = ST $ \s1# ->
1329 case writeInt64Array# marr# i# e# s1# of { s2# ->
1330 (# s2#, () #) }
1331
1332 instance MArray (STUArray s) Word8 (ST s) where
1333 {-# INLINE newArray_ #-}
1334 newArray_ (l,u) = ST $ \s1# ->
1335 case rangeSize (l,u) of { I# n# ->
1336 case newByteArray# n# s1# of { (# s2#, marr# #) ->
1337 (# s2#, STUArray l u marr# #) }}
1338 {-# INLINE unsafeRead #-}
1339 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1340 case readWord8Array# marr# i# s1# of { (# s2#, e# #) ->
1341 (# s2#, W8# e# #) }
1342 {-# INLINE unsafeWrite #-}
1343 unsafeWrite (STUArray _ _ marr#) (I# i#) (W8# e#) = ST $ \s1# ->
1344 case writeWord8Array# marr# i# e# s1# of { s2# ->
1345 (# s2#, () #) }
1346
1347 instance MArray (STUArray s) Word16 (ST s) where
1348 {-# INLINE newArray_ #-}
1349 newArray_ (l,u) = ST $ \s1# ->
1350 case rangeSize (l,u) of { I# n# ->
1351 case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) ->
1352 (# s2#, STUArray l u marr# #) }}
1353 {-# INLINE unsafeRead #-}
1354 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1355 case readWord16Array# marr# i# s1# of { (# s2#, e# #) ->
1356 (# s2#, W16# e# #) }
1357 {-# INLINE unsafeWrite #-}
1358 unsafeWrite (STUArray _ _ marr#) (I# i#) (W16# e#) = ST $ \s1# ->
1359 case writeWord16Array# marr# i# e# s1# of { s2# ->
1360 (# s2#, () #) }
1361
1362 instance MArray (STUArray s) Word32 (ST s) where
1363 {-# INLINE newArray_ #-}
1364 newArray_ (l,u) = ST $ \s1# ->
1365 case rangeSize (l,u) of { I# n# ->
1366 case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
1367 (# s2#, STUArray l u marr# #) }}
1368 {-# INLINE unsafeRead #-}
1369 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1370 case readWord32Array# marr# i# s1# of { (# s2#, e# #) ->
1371 (# s2#, W32# e# #) }
1372 {-# INLINE unsafeWrite #-}
1373 unsafeWrite (STUArray _ _ marr#) (I# i#) (W32# e#) = ST $ \s1# ->
1374 case writeWord32Array# marr# i# e# s1# of { s2# ->
1375 (# s2#, () #) }
1376
1377 instance MArray (STUArray s) Word64 (ST s) where
1378 {-# INLINE newArray_ #-}
1379 newArray_ (l,u) = ST $ \s1# ->
1380 case rangeSize (l,u) of { I# n# ->
1381 case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) ->
1382 (# s2#, STUArray l u marr# #) }}
1383 {-# INLINE unsafeRead #-}
1384 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1385 case readWord64Array# marr# i# s1# of { (# s2#, e# #) ->
1386 (# s2#, W64# e# #) }
1387 {-# INLINE unsafeWrite #-}
1388 unsafeWrite (STUArray _ _ marr#) (I# i#) (W64# e#) = ST $ \s1# ->
1389 case writeWord64Array# marr# i# e# s1# of { s2# ->
1390 (# s2#, () #) }
1391
1392 -----------------------------------------------------------------------------
1393 -- Translation between elements and bytes
1394
1395 bOOL_SCALE, bOOL_WORD_SCALE,
1396 wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int#
1397 bOOL_SCALE n# = (n# +# last#) `uncheckedIShiftRA#` 3#
1398 where I# last# = SIZEOF_HSWORD * 8 - 1
1399 bOOL_WORD_SCALE n# = bOOL_INDEX (n# +# last#)
1400 where I# last# = SIZEOF_HSWORD * 8 - 1
1401 wORD_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSWORD
1402 dOUBLE_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSDOUBLE
1403 fLOAT_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSFLOAT
1404
1405 bOOL_INDEX :: Int# -> Int#
1406 #if SIZEOF_HSWORD == 4
1407 bOOL_INDEX i# = i# `uncheckedIShiftRA#` 5#
1408 #elif SIZEOF_HSWORD == 8
1409 bOOL_INDEX i# = i# `uncheckedIShiftRA#` 6#
1410 #endif
1411
1412 bOOL_BIT, bOOL_NOT_BIT :: Int# -> Word#
1413 bOOL_BIT n# = int2Word# 1# `uncheckedShiftL#` (word2Int# (int2Word# n# `and#` mask#))
1414 where W# mask# = SIZEOF_HSWORD * 8 - 1
1415 bOOL_NOT_BIT n# = bOOL_BIT n# `xor#` mb# where W# mb# = maxBound
1416 #endif /* __GLASGOW_HASKELL__ */
1417
1418 #ifdef __HUGS__
1419 newMBArray_ :: (Ix i, Storable e) => (i,i) -> ST s (STUArray s i e)
1420 newMBArray_ = makeArray undefined
1421 where
1422 makeArray :: (Ix i, Storable e) => e -> (i,i) -> ST s (STUArray s i e)
1423 makeArray dummy (l,u) = do
1424 marr <- newMutableByteArray (rangeSize (l,u) * sizeOf dummy)
1425 return (STUArray l u marr)
1426
1427 unsafeReadMBArray :: Storable e => STUArray s i e -> Int -> ST s e
1428 unsafeReadMBArray (STUArray _ _ marr) = readMutableByteArray marr
1429
1430 unsafeWriteMBArray :: Storable e => STUArray s i e -> Int -> e -> ST s ()
1431 unsafeWriteMBArray (STUArray _ _ marr) = writeMutableByteArray marr
1432
1433 instance MArray (STUArray s) Bool (ST s) where
1434 newArray_ (l,u) = do
1435 marr <- newMutableByteArray (bOOL_SCALE (rangeSize (l,u)))
1436 return (STUArray l u marr)
1437 unsafeRead (STUArray _ _ marr) i = do
1438 let ix = bOOL_INDEX i
1439 bit = bOOL_SUBINDEX i
1440 w <- readMutableByteArray marr ix
1441 return (testBit (w::BitSet) bit)
1442 unsafeWrite (STUArray _ _ marr) i e = do
1443 let ix = bOOL_INDEX i
1444 bit = bOOL_SUBINDEX i
1445 w <- readMutableByteArray marr ix
1446 writeMutableByteArray marr ix
1447 (if e then setBit (w::BitSet) bit else clearBit w bit)
1448
1449 instance MArray (STUArray s) Char (ST s) where
1450 newArray_ = newMBArray_
1451 unsafeRead = unsafeReadMBArray
1452 unsafeWrite = unsafeWriteMBArray
1453
1454 instance MArray (STUArray s) Int (ST s) where
1455 newArray_ = newMBArray_
1456 unsafeRead = unsafeReadMBArray
1457 unsafeWrite = unsafeWriteMBArray
1458
1459 instance MArray (STUArray s) Word (ST s) where
1460 newArray_ = newMBArray_
1461 unsafeRead = unsafeReadMBArray
1462 unsafeWrite = unsafeWriteMBArray
1463
1464 instance MArray (STUArray s) (Ptr a) (ST s) where
1465 newArray_ = newMBArray_
1466 unsafeRead = unsafeReadMBArray
1467 unsafeWrite = unsafeWriteMBArray
1468
1469 instance MArray (STUArray s) (FunPtr a) (ST s) where
1470 newArray_ = newMBArray_
1471 unsafeRead = unsafeReadMBArray
1472 unsafeWrite = unsafeWriteMBArray
1473
1474 instance MArray (STUArray s) Float (ST s) where
1475 newArray_ = newMBArray_
1476 unsafeRead = unsafeReadMBArray
1477 unsafeWrite = unsafeWriteMBArray
1478
1479 instance MArray (STUArray s) Double (ST s) where
1480 newArray_ = newMBArray_
1481 unsafeRead = unsafeReadMBArray
1482 unsafeWrite = unsafeWriteMBArray
1483
1484 instance MArray (STUArray s) (StablePtr a) (ST s) where
1485 newArray_ = newMBArray_
1486 unsafeRead = unsafeReadMBArray
1487 unsafeWrite = unsafeWriteMBArray
1488
1489 instance MArray (STUArray s) Int8 (ST s) where
1490 newArray_ = newMBArray_
1491 unsafeRead = unsafeReadMBArray
1492 unsafeWrite = unsafeWriteMBArray
1493
1494 instance MArray (STUArray s) Int16 (ST s) where
1495 newArray_ = newMBArray_
1496 unsafeRead = unsafeReadMBArray
1497 unsafeWrite = unsafeWriteMBArray
1498
1499 instance MArray (STUArray s) Int32 (ST s) where
1500 newArray_ = newMBArray_
1501 unsafeRead = unsafeReadMBArray
1502 unsafeWrite = unsafeWriteMBArray
1503
1504 instance MArray (STUArray s) Int64 (ST s) where
1505 newArray_ = newMBArray_
1506 unsafeRead = unsafeReadMBArray
1507 unsafeWrite = unsafeWriteMBArray
1508
1509 instance MArray (STUArray s) Word8 (ST s) where
1510 newArray_ = newMBArray_
1511 unsafeRead = unsafeReadMBArray
1512 unsafeWrite = unsafeWriteMBArray
1513
1514 instance MArray (STUArray s) Word16 (ST s) where
1515 newArray_ = newMBArray_
1516 unsafeRead = unsafeReadMBArray
1517 unsafeWrite = unsafeWriteMBArray
1518
1519 instance MArray (STUArray s) Word32 (ST s) where
1520 newArray_ = newMBArray_
1521 unsafeRead = unsafeReadMBArray
1522 unsafeWrite = unsafeWriteMBArray
1523
1524 instance MArray (STUArray s) Word64 (ST s) where
1525 newArray_ = newMBArray_
1526 unsafeRead = unsafeReadMBArray
1527 unsafeWrite = unsafeWriteMBArray
1528
1529 type BitSet = Word8
1530
1531 bitSetSize = bitSize (0::BitSet)
1532
1533 bOOL_SCALE :: Int -> Int
1534 bOOL_SCALE n = (n + bitSetSize - 1) `div` bitSetSize
1535
1536 bOOL_INDEX :: Int -> Int
1537 bOOL_INDEX i = i `div` bitSetSize
1538
1539 bOOL_SUBINDEX :: Int -> Int
1540 bOOL_SUBINDEX i = i `mod` bitSetSize
1541 #endif /* __HUGS__ */
1542
1543 -----------------------------------------------------------------------------
1544 -- Freezing
1545
1546 -- | Converts a mutable array (any instance of 'MArray') to an
1547 -- immutable array (any instance of 'IArray') by taking a complete
1548 -- copy of it.
1549 freeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
1550 freeze marr = case bounds marr of
1551 (l,u) -> do
1552 ies <- sequence [do e <- unsafeRead marr i; return (i,e)
1553 | i <- [0 .. rangeSize (l,u) - 1]]
1554 return (unsafeArray (l,u) ies)
1555
1556 #ifdef __GLASGOW_HASKELL__
1557 freezeSTUArray :: Ix i => STUArray s i e -> ST s (UArray i e)
1558 freezeSTUArray (STUArray l u marr#) = ST $ \s1# ->
1559 case sizeofMutableByteArray# marr# of { n# ->
1560 case newByteArray# n# s1# of { (# s2#, marr'# #) ->
1561 case unsafeCoerce# memcpy marr'# marr# n# s2# of { (# s3#, () #) ->
1562 case unsafeFreezeByteArray# marr'# s3# of { (# s4#, arr# #) ->
1563 (# s4#, UArray l u arr# #) }}}}
1564
1565 {-# RULES
1566 "freeze/STArray" freeze = ArrST.freezeSTArray
1567 "freeze/STUArray" freeze = freezeSTUArray
1568 #-}
1569 #endif /* __GLASGOW_HASKELL__ */
1570
1571 -- In-place conversion of mutable arrays to immutable ones places
1572 -- a proof obligation on the user: no other parts of your code can
1573 -- have a reference to the array at the point where you unsafely
1574 -- freeze it (and, subsequently mutate it, I suspect).
1575
1576 {- |
1577 Converts an mutable array into an immutable array. The
1578 implementation may either simply cast the array from
1579 one type to the other without copying the array, or it
1580 may take a full copy of the array.
1581
1582 Note that because the array is possibly not copied, any subsequent
1583 modifications made to the mutable version of the array may be
1584 shared with the immutable version. It is safe to use, therefore, if
1585 the mutable version is never modified after the freeze operation.
1586
1587 The non-copying implementation is supported between certain pairs
1588 of array types only; one constraint is that the array types must
1589 have identical representations. In GHC, The following pairs of
1590 array types have a non-copying O(1) implementation of
1591 'unsafeFreeze'. Because the optimised versions are enabled by
1592 specialisations, you will need to compile with optimisation (-O) to
1593 get them.
1594
1595 * 'Data.Array.IO.IOUArray' -> 'Data.Array.Unboxed.UArray'
1596
1597 * 'Data.Array.ST.STUArray' -> 'Data.Array.Unboxed.UArray'
1598
1599 * 'Data.Array.IO.IOArray' -> 'Data.Array.Array'
1600
1601 * 'Data.Array.ST.STArray' -> 'Data.Array.Array'
1602 -}
1603 {-# INLINE unsafeFreeze #-}
1604 unsafeFreeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
1605 unsafeFreeze = freeze
1606
1607 {-# RULES
1608 "unsafeFreeze/STArray" unsafeFreeze = ArrST.unsafeFreezeSTArray
1609 "unsafeFreeze/STUArray" unsafeFreeze = unsafeFreezeSTUArray
1610 #-}
1611
1612 -----------------------------------------------------------------------------
1613 -- Thawing
1614
1615 -- | Converts an immutable array (any instance of 'IArray') into a
1616 -- mutable array (any instance of 'MArray') by taking a complete copy
1617 -- of it.
1618 thaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
1619 thaw arr = case bounds arr of
1620 (l,u) -> do
1621 marr <- newArray_ (l,u)
1622 sequence_ [unsafeWrite marr i (unsafeAt arr i)
1623 | i <- [0 .. rangeSize (l,u) - 1]]
1624 return marr
1625
1626 #ifdef __GLASGOW_HASKELL__
1627 thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1628 thawSTUArray (UArray l u arr#) = ST $ \s1# ->
1629 case sizeofByteArray# arr# of { n# ->
1630 case newByteArray# n# s1# of { (# s2#, marr# #) ->
1631 case unsafeCoerce# memcpy marr# arr# n# s2# of { (# s3#, () #) ->
1632 (# s3#, STUArray l u marr# #) }}}
1633
1634 foreign import ccall unsafe "memcpy"
1635 memcpy :: MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO ()
1636
1637 {-# RULES
1638 "thaw/STArray" thaw = ArrST.thawSTArray
1639 "thaw/STUArray" thaw = thawSTUArray
1640 #-}
1641 #endif /* __GLASGOW_HASKELL__ */
1642
1643 #ifdef __HUGS__
1644 thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1645 thawSTUArray (UArray l u arr) = do
1646 marr <- thawByteArray arr
1647 return (STUArray l u marr)
1648 #endif
1649
1650 -- In-place conversion of immutable arrays to mutable ones places
1651 -- a proof obligation on the user: no other parts of your code can
1652 -- have a reference to the array at the point where you unsafely
1653 -- thaw it (and, subsequently mutate it, I suspect).
1654
1655 {- |
1656 Converts an immutable array into a mutable array. The
1657 implementation may either simply cast the array from
1658 one type to the other without copying the array, or it
1659 may take a full copy of the array.
1660
1661 Note that because the array is possibly not copied, any subsequent
1662 modifications made to the mutable version of the array may be
1663 shared with the immutable version. It is safe to use, therefore, if
1664 the immutable version is never referenced again.
1665
1666 The non-copying implementation is supported between certain pairs
1667 of array types only; one constraint is that the array types must
1668 have identical representations. In GHC, The following pairs of
1669 array types have a non-copying O(1) implementation of
1670 'unsafeFreeze'. Because the optimised versions are enabled by
1671 specialisations, you will need to compile with optimisation (-O) to
1672 get them.
1673
1674 * 'Data.Array.Unboxed.UArray' -> 'Data.Array.IO.IOUArray'
1675
1676 * 'Data.Array.Unboxed.UArray' -> 'Data.Array.ST.STUArray'
1677
1678 * 'Data.Array.Array' -> 'Data.Array.IO.IOArray'
1679
1680 * 'Data.Array.Array' -> 'Data.Array.ST.STArray'
1681 -}
1682 {-# INLINE unsafeThaw #-}
1683 unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
1684 unsafeThaw = thaw
1685
1686 #ifdef __GLASGOW_HASKELL__
1687 {-# INLINE unsafeThawSTUArray #-}
1688 unsafeThawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1689 unsafeThawSTUArray (UArray l u marr#) =
1690 return (STUArray l u (unsafeCoerce# marr#))
1691
1692 {-# RULES
1693 "unsafeThaw/STArray" unsafeThaw = ArrST.unsafeThawSTArray
1694 "unsafeThaw/STUArray" unsafeThaw = unsafeThawSTUArray
1695 #-}
1696 #endif /* __GLASGOW_HASKELL__ */
1697
1698 -- | Casts an 'STUArray' with one element type into one with a
1699 -- different element type. All the elements of the resulting array
1700 -- are undefined (unless you know what you\'re doing...).
1701
1702 #ifdef __GLASGOW_HASKELL__
1703 castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
1704 castSTUArray (STUArray l u marr#) = return (STUArray l u marr#)
1705 #endif
1706
1707 #ifdef __HUGS__
1708 castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
1709 castSTUArray (STUArray l u marr) = return (STUArray l u marr)
1710 #endif