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