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