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