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