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