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