base: Manually unlit .lhs into .hs modules
[ghc.git] / libraries / base / GHC / Arr.hs
1 {-# LANGUAGE Unsafe #-}
2 {-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
3 {-# OPTIONS_GHC -funbox-strict-fields #-}
4 {-# OPTIONS_HADDOCK hide #-}
5
6 -----------------------------------------------------------------------------
7 -- |
8 -- Module : GHC.Arr
9 -- Copyright : (c) The University of Glasgow, 1994-2000
10 -- License : see libraries/base/LICENSE
11 --
12 -- Maintainer : cvs-ghc@haskell.org
13 -- Stability : internal
14 -- Portability : non-portable (GHC extensions)
15 --
16 -- GHC\'s array implementation.
17 --
18 -----------------------------------------------------------------------------
19
20 module GHC.Arr (
21 Ix(..), Array(..), STArray(..),
22
23 indexError, hopelessIndexError,
24 arrEleBottom, array, listArray,
25 (!), safeRangeSize, negRange, safeIndex, badSafeIndex,
26 bounds, numElements, numElementsSTArray, indices, elems,
27 assocs, accumArray, adjust, (//), accum,
28 amap, ixmap,
29 eqArray, cmpArray, cmpIntArray,
30 newSTArray, boundsSTArray,
31 readSTArray, writeSTArray,
32 freezeSTArray, thawSTArray,
33
34 -- * Unsafe operations
35 fill, done,
36 unsafeArray, unsafeArray',
37 lessSafeIndex, unsafeAt, unsafeReplace,
38 unsafeAccumArray, unsafeAccumArray', unsafeAccum,
39 unsafeReadSTArray, unsafeWriteSTArray,
40 unsafeFreezeSTArray, unsafeThawSTArray,
41 ) where
42
43 import GHC.Enum
44 import GHC.Num
45 import GHC.ST
46 import GHC.Base
47 import GHC.List
48 import GHC.Real( fromIntegral )
49 import GHC.Show
50
51 infixl 9 !, //
52
53 default ()
54
55 -- | The 'Ix' class is used to map a contiguous subrange of values in
56 -- a type onto integers. It is used primarily for array indexing
57 -- (see the array package).
58 --
59 -- The first argument @(l,u)@ of each of these operations is a pair
60 -- specifying the lower and upper bounds of a contiguous subrange of values.
61 --
62 -- An implementation is entitled to assume the following laws about these
63 -- operations:
64 --
65 -- * @'inRange' (l,u) i == 'elem' i ('range' (l,u))@ @ @
66 --
67 -- * @'range' (l,u) '!!' 'index' (l,u) i == i@, when @'inRange' (l,u) i@
68 --
69 -- * @'map' ('index' (l,u)) ('range' (l,u))) == [0..'rangeSize' (l,u)-1]@ @ @
70 --
71 -- * @'rangeSize' (l,u) == 'length' ('range' (l,u))@ @ @
72 --
73 -- Minimal complete instance: 'range', 'index' and 'inRange'.
74 --
75 class (Ord a) => Ix a where
76 -- | The list of values in the subrange defined by a bounding pair.
77 range :: (a,a) -> [a]
78 -- | The position of a subscript in the subrange.
79 index :: (a,a) -> a -> Int
80 -- | Like 'index', but without checking that the value is in range.
81 unsafeIndex :: (a,a) -> a -> Int
82 -- | Returns 'True' the given subscript lies in the range defined
83 -- the bounding pair.
84 inRange :: (a,a) -> a -> Bool
85 -- | The size of the subrange defined by a bounding pair.
86 rangeSize :: (a,a) -> Int
87 -- | like 'rangeSize', but without checking that the upper bound is
88 -- in range.
89 unsafeRangeSize :: (a,a) -> Int
90
91 -- Must specify one of index, unsafeIndex
92
93 -- 'index' is typically over-ridden in instances, with essentially
94 -- the same code, but using indexError instead of hopelessIndexError
95 -- Reason: we have 'Show' at the instances
96 {-# INLINE index #-} -- See Note [Inlining index]
97 index b i | inRange b i = unsafeIndex b i
98 | otherwise = hopelessIndexError
99
100 unsafeIndex b i = index b i
101
102 rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1
103 | otherwise = 0 -- This case is only here to
104 -- check for an empty range
105 -- NB: replacing (inRange b h) by (l <= h) fails for
106 -- tuples. E.g. (1,2) <= (2,1) but the range is empty
107
108 unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
109
110 {-
111 Note that the following is NOT right
112 rangeSize (l,h) | l <= h = index b h + 1
113 | otherwise = 0
114
115 Because it might be the case that l<h, but the range
116 is nevertheless empty. Consider
117 ((1,2),(2,1))
118 Here l<h, but the second index ranges from 2..1 and
119 hence is empty
120
121
122 Note [Inlining index]
123 ~~~~~~~~~~~~~~~~~~~~~
124 We inline the 'index' operation,
125
126 * Partly because it generates much faster code
127 (although bigger); see Trac #1216
128
129 * Partly because it exposes the bounds checks to the simplifier which
130 might help a big.
131
132 If you make a per-instance index method, you may consider inlining it.
133
134 Note [Double bounds-checking of index values]
135 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
136 When you index an array, a!x, there are two possible bounds checks we might make:
137
138 (A) Check that (inRange (bounds a) x) holds.
139
140 (A) is checked in the method for 'index'
141
142 (B) Check that (index (bounds a) x) lies in the range 0..n,
143 where n is the size of the underlying array
144
145 (B) is checked in the top-level function (!), in safeIndex.
146
147 Of course it *should* be the case that (A) holds iff (B) holds, but that
148 is a property of the particular instances of index, bounds, and inRange,
149 so GHC cannot guarantee it.
150
151 * If you do (A) and not (B), then you might get a seg-fault,
152 by indexing at some bizarre location. Trac #1610
153
154 * If you do (B) but not (A), you may get no complaint when you index
155 an array out of its semantic bounds. Trac #2120
156
157 At various times we have had (A) and not (B), or (B) and not (A); both
158 led to complaints. So now we implement *both* checks (Trac #2669).
159
160 For 1-d, 2-d, and 3-d arrays of Int we have specialised instances to avoid this.
161
162 Note [Out-of-bounds error messages]
163 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
164 The default method for 'index' generates hoplelessIndexError, because
165 Ix doesn't have Show as a superclass. For particular base types we
166 can do better, so we override the default method for index.
167 -}
168
169 -- Abstract these errors from the relevant index functions so that
170 -- the guts of the function will be small enough to inline.
171
172 {-# NOINLINE indexError #-}
173 indexError :: Show a => (a,a) -> a -> String -> b
174 indexError rng i tp
175 = error (showString "Ix{" . showString tp . showString "}.index: Index " .
176 showParen True (showsPrec 0 i) .
177 showString " out of range " $
178 showParen True (showsPrec 0 rng) "")
179
180 hopelessIndexError :: Int -- Try to use 'indexError' instead!
181 hopelessIndexError = error "Error in array index"
182
183 ----------------------------------------------------------------------
184 instance Ix Char where
185 {-# INLINE range #-}
186 range (m,n) = [m..n]
187
188 {-# INLINE unsafeIndex #-}
189 unsafeIndex (m,_n) i = fromEnum i - fromEnum m
190
191 {-# INLINE index #-} -- See Note [Out-of-bounds error messages]
192 -- and Note [Inlining index]
193 index b i | inRange b i = unsafeIndex b i
194 | otherwise = indexError b i "Char"
195
196 inRange (m,n) i = m <= i && i <= n
197
198 ----------------------------------------------------------------------
199 instance Ix Int where
200 {-# INLINE range #-}
201 -- The INLINE stops the build in the RHS from getting inlined,
202 -- so that callers can fuse with the result of range
203 range (m,n) = [m..n]
204
205 {-# INLINE unsafeIndex #-}
206 unsafeIndex (m,_n) i = i - m
207
208 {-# INLINE index #-} -- See Note [Out-of-bounds error messages]
209 -- and Note [Inlining index]
210 index b i | inRange b i = unsafeIndex b i
211 | otherwise = indexError b i "Int"
212
213 {-# INLINE inRange #-}
214 inRange (I# m,I# n) (I# i) = isTrue# (m <=# i) && isTrue# (i <=# n)
215
216 instance Ix Word where
217 range (m,n) = [m..n]
218 unsafeIndex (m,_) i = fromIntegral (i - m)
219 inRange (m,n) i = m <= i && i <= n
220
221 ----------------------------------------------------------------------
222 instance Ix Integer where
223 {-# INLINE range #-}
224 range (m,n) = [m..n]
225
226 {-# INLINE unsafeIndex #-}
227 unsafeIndex (m,_n) i = fromInteger (i - m)
228
229 {-# INLINE index #-} -- See Note [Out-of-bounds error messages]
230 -- and Note [Inlining index]
231 index b i | inRange b i = unsafeIndex b i
232 | otherwise = indexError b i "Integer"
233
234 inRange (m,n) i = m <= i && i <= n
235
236 ----------------------------------------------------------------------
237 instance Ix Bool where -- as derived
238 {-# INLINE range #-}
239 range (m,n) = [m..n]
240
241 {-# INLINE unsafeIndex #-}
242 unsafeIndex (l,_) i = fromEnum i - fromEnum l
243
244 {-# INLINE index #-} -- See Note [Out-of-bounds error messages]
245 -- and Note [Inlining index]
246 index b i | inRange b i = unsafeIndex b i
247 | otherwise = indexError b i "Bool"
248
249 inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
250
251 ----------------------------------------------------------------------
252 instance Ix Ordering where -- as derived
253 {-# INLINE range #-}
254 range (m,n) = [m..n]
255
256 {-# INLINE unsafeIndex #-}
257 unsafeIndex (l,_) i = fromEnum i - fromEnum l
258
259 {-# INLINE index #-} -- See Note [Out-of-bounds error messages]
260 -- and Note [Inlining index]
261 index b i | inRange b i = unsafeIndex b i
262 | otherwise = indexError b i "Ordering"
263
264 inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
265
266 ----------------------------------------------------------------------
267 instance Ix () where
268 {-# INLINE range #-}
269 range ((), ()) = [()]
270 {-# INLINE unsafeIndex #-}
271 unsafeIndex ((), ()) () = 0
272 {-# INLINE inRange #-}
273 inRange ((), ()) () = True
274
275 {-# INLINE index #-} -- See Note [Inlining index]
276 index b i = unsafeIndex b i
277
278 ----------------------------------------------------------------------
279 instance (Ix a, Ix b) => Ix (a, b) where -- as derived
280 {-# SPECIALISE instance Ix (Int,Int) #-}
281
282 {-# INLINE range #-}
283 range ((l1,l2),(u1,u2)) =
284 [ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ]
285
286 {-# INLINE unsafeIndex #-}
287 unsafeIndex ((l1,l2),(u1,u2)) (i1,i2) =
288 unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2
289
290 {-# INLINE inRange #-}
291 inRange ((l1,l2),(u1,u2)) (i1,i2) =
292 inRange (l1,u1) i1 && inRange (l2,u2) i2
293
294 -- Default method for index
295
296 ----------------------------------------------------------------------
297 instance (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3) where
298 {-# SPECIALISE instance Ix (Int,Int,Int) #-}
299
300 range ((l1,l2,l3),(u1,u2,u3)) =
301 [(i1,i2,i3) | i1 <- range (l1,u1),
302 i2 <- range (l2,u2),
303 i3 <- range (l3,u3)]
304
305 unsafeIndex ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
306 unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
307 unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
308 unsafeIndex (l1,u1) i1))
309
310 inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
311 inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
312 inRange (l3,u3) i3
313
314 -- Default method for index
315
316 ----------------------------------------------------------------------
317 instance (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4) where
318 range ((l1,l2,l3,l4),(u1,u2,u3,u4)) =
319 [(i1,i2,i3,i4) | i1 <- range (l1,u1),
320 i2 <- range (l2,u2),
321 i3 <- range (l3,u3),
322 i4 <- range (l4,u4)]
323
324 unsafeIndex ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
325 unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
326 unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
327 unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
328 unsafeIndex (l1,u1) i1)))
329
330 inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
331 inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
332 inRange (l3,u3) i3 && inRange (l4,u4) i4
333
334 -- Default method for index
335
336 instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5) where
337 range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) =
338 [(i1,i2,i3,i4,i5) | i1 <- range (l1,u1),
339 i2 <- range (l2,u2),
340 i3 <- range (l3,u3),
341 i4 <- range (l4,u4),
342 i5 <- range (l5,u5)]
343
344 unsafeIndex ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
345 unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * (
346 unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
347 unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
348 unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
349 unsafeIndex (l1,u1) i1))))
350
351 inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
352 inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
353 inRange (l3,u3) i3 && inRange (l4,u4) i4 &&
354 inRange (l5,u5) i5
355
356 -- Default method for index
357
358 -- | The type of immutable non-strict (boxed) arrays
359 -- with indices in @i@ and elements in @e@.
360 data Array i e
361 = Array !i -- the lower bound, l
362 !i -- the upper bound, u
363 {-# UNPACK #-} !Int -- A cache of (rangeSize (l,u))
364 -- used to make sure an index is
365 -- really in range
366 (Array# e) -- The actual elements
367
368 -- | Mutable, boxed, non-strict arrays in the 'ST' monad. The type
369 -- arguments are as follows:
370 --
371 -- * @s@: the state variable argument for the 'ST' type
372 --
373 -- * @i@: the index type of the array (should be an instance of 'Ix')
374 --
375 -- * @e@: the element type of the array.
376 --
377 data STArray s i e
378 = STArray !i -- the lower bound, l
379 !i -- the upper bound, u
380 {-# UNPACK #-} !Int -- A cache of (rangeSize (l,u))
381 -- used to make sure an index is
382 -- really in range
383 (MutableArray# s e) -- The actual elements
384 -- No Ix context for STArray. They are stupid,
385 -- and force an Ix context on the equality instance.
386
387 -- Just pointer equality on mutable arrays:
388 instance Eq (STArray s i e) where
389 STArray _ _ _ arr1# == STArray _ _ _ arr2# =
390 isTrue# (sameMutableArray# arr1# arr2#)
391
392 ----------------------------------------------------------------------
393 -- Operations on immutable arrays
394
395 {-# NOINLINE arrEleBottom #-}
396 arrEleBottom :: a
397 arrEleBottom = error "(Array.!): undefined array element"
398
399 -- | Construct an array with the specified bounds and containing values
400 -- for given indices within these bounds.
401 --
402 -- The array is undefined (i.e. bottom) if any index in the list is
403 -- out of bounds. The Haskell 2010 Report further specifies that if any
404 -- two associations in the list have the same index, the value at that
405 -- index is undefined (i.e. bottom). However in GHC's implementation,
406 -- the value at such an index is the value part of the last association
407 -- with that index in the list.
408 --
409 -- Because the indices must be checked for these errors, 'array' is
410 -- strict in the bounds argument and in the indices of the association
411 -- list, but non-strict in the values. Thus, recurrences such as the
412 -- following are possible:
413 --
414 -- > a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i <- [2..100]])
415 --
416 -- Not every index within the bounds of the array need appear in the
417 -- association list, but the values associated with indices that do not
418 -- appear will be undefined (i.e. bottom).
419 --
420 -- If, in any dimension, the lower bound is greater than the upper bound,
421 -- then the array is legal, but empty. Indexing an empty array always
422 -- gives an array-bounds error, but 'bounds' still yields the bounds
423 -- with which the array was constructed.
424 {-# INLINE array #-}
425 array :: Ix i
426 => (i,i) -- ^ a pair of /bounds/, each of the index type
427 -- of the array. These bounds are the lowest and
428 -- highest indices in the array, in that order.
429 -- For example, a one-origin vector of length
430 -- '10' has bounds '(1,10)', and a one-origin '10'
431 -- by '10' matrix has bounds '((1,1),(10,10))'.
432 -> [(i, e)] -- ^ a list of /associations/ of the form
433 -- (/index/, /value/). Typically, this list will
434 -- be expressed as a comprehension. An
435 -- association '(i, x)' defines the value of
436 -- the array at index 'i' to be 'x'.
437 -> Array i e
438 array (l,u) ies
439 = let n = safeRangeSize (l,u)
440 in unsafeArray' (l,u) n
441 [(safeIndex (l,u) n i, e) | (i, e) <- ies]
442
443 {-# INLINE unsafeArray #-}
444 unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> Array i e
445 unsafeArray b ies = unsafeArray' b (rangeSize b) ies
446
447 {-# INLINE unsafeArray' #-}
448 unsafeArray' :: Ix i => (i,i) -> Int -> [(Int, e)] -> Array i e
449 unsafeArray' (l,u) n@(I# n#) ies = runST (ST $ \s1# ->
450 case newArray# n# arrEleBottom s1# of
451 (# s2#, marr# #) ->
452 foldr (fill marr#) (done l u n marr#) ies s2#)
453
454 {-# INLINE fill #-}
455 fill :: MutableArray# s e -> (Int, e) -> STRep s a -> STRep s a
456 -- NB: put the \s after the "=" so that 'fill'
457 -- inlines when applied to three args
458 fill marr# (I# i#, e) next
459 = \s1# -> case writeArray# marr# i# e s1# of
460 s2# -> next s2#
461
462 {-# INLINE done #-}
463 done :: Ix i => i -> i -> Int -> MutableArray# s e -> STRep s (Array i e)
464 -- See NB on 'fill'
465 -- Make sure it is strict in 'n'
466 done l u n@(I# _) marr#
467 = \s1# -> case unsafeFreezeArray# marr# s1# of
468 (# s2#, arr# #) -> (# s2#, Array l u n arr# #)
469
470 -- This is inefficient and I'm not sure why:
471 -- listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es)
472 -- The code below is better. It still doesn't enable foldr/build
473 -- transformation on the list of elements; I guess it's impossible
474 -- using mechanisms currently available.
475
476 -- | Construct an array from a pair of bounds and a list of values in
477 -- index order.
478 {-# INLINE listArray #-}
479 listArray :: Ix i => (i,i) -> [e] -> Array i e
480 listArray (l,u) es = runST (ST $ \s1# ->
481 case safeRangeSize (l,u) of { n@(I# n#) ->
482 case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) ->
483 let fillFromList i# xs s3# | isTrue# (i# ==# n#) = s3#
484 | otherwise = case xs of
485 [] -> s3#
486 y:ys -> case writeArray# marr# i# y s3# of { s4# ->
487 fillFromList (i# +# 1#) ys s4# } in
488 case fillFromList 0# es s2# of { s3# ->
489 done l u n marr# s3# }}})
490
491 -- | The value at the given index in an array.
492 {-# INLINE (!) #-}
493 (!) :: Ix i => Array i e -> i -> e
494 arr@(Array l u n _) ! i = unsafeAt arr $ safeIndex (l,u) n i
495
496 {-# INLINE safeRangeSize #-}
497 safeRangeSize :: Ix i => (i, i) -> Int
498 safeRangeSize (l,u) = let r = rangeSize (l, u)
499 in if r < 0 then negRange
500 else r
501
502 -- Don't inline this error message everywhere!!
503 negRange :: Int -- Uninformative, but Ix does not provide Show
504 negRange = error "Negative range size"
505
506 {-# INLINE[1] safeIndex #-}
507 -- See Note [Double bounds-checking of index values]
508 -- Inline *after* (!) so the rules can fire
509 -- Make sure it is strict in n
510 safeIndex :: Ix i => (i, i) -> Int -> i -> Int
511 safeIndex (l,u) n@(I# _) i
512 | (0 <= i') && (i' < n) = i'
513 | otherwise = badSafeIndex i' n
514 where
515 i' = index (l,u) i
516
517 -- See Note [Double bounds-checking of index values]
518 {-# RULES
519 "safeIndex/I" safeIndex = lessSafeIndex :: (Int,Int) -> Int -> Int -> Int
520 "safeIndex/(I,I)" safeIndex = lessSafeIndex :: ((Int,Int),(Int,Int)) -> Int -> (Int,Int) -> Int
521 "safeIndex/(I,I,I)" safeIndex = lessSafeIndex :: ((Int,Int,Int),(Int,Int,Int)) -> Int -> (Int,Int,Int) -> Int
522 #-}
523
524 lessSafeIndex :: Ix i => (i, i) -> Int -> i -> Int
525 -- See Note [Double bounds-checking of index values]
526 -- Do only (A), the semantic check
527 lessSafeIndex (l,u) _ i = index (l,u) i
528
529 -- Don't inline this long error message everywhere!!
530 badSafeIndex :: Int -> Int -> Int
531 badSafeIndex i' n = error ("Error in array index; " ++ show i' ++
532 " not in range [0.." ++ show n ++ ")")
533
534 {-# INLINE unsafeAt #-}
535 unsafeAt :: Ix i => Array i e -> Int -> e
536 unsafeAt (Array _ _ _ arr#) (I# i#) =
537 case indexArray# arr# i# of (# e #) -> e
538
539 -- | The bounds with which an array was constructed.
540 {-# INLINE bounds #-}
541 bounds :: Ix i => Array i e -> (i,i)
542 bounds (Array l u _ _) = (l,u)
543
544 -- | The number of elements in the array.
545 {-# INLINE numElements #-}
546 numElements :: Ix i => Array i e -> Int
547 numElements (Array _ _ n _) = n
548
549 -- | The list of indices of an array in ascending order.
550 {-# INLINE indices #-}
551 indices :: Ix i => Array i e -> [i]
552 indices (Array l u _ _) = range (l,u)
553
554 -- | The list of elements of an array in index order.
555 {-# INLINE elems #-}
556 elems :: Ix i => Array i e -> [e]
557 elems arr@(Array _ _ n _) =
558 [unsafeAt arr i | i <- [0 .. n - 1]]
559
560 -- | The list of associations of an array in index order.
561 {-# INLINE assocs #-}
562 assocs :: Ix i => Array i e -> [(i, e)]
563 assocs arr@(Array l u _ _) =
564 [(i, arr ! i) | i <- range (l,u)]
565
566 -- | The 'accumArray' function deals with repeated indices in the association
567 -- list using an /accumulating function/ which combines the values of
568 -- associations with the same index.
569 -- For example, given a list of values of some index type, @hist@
570 -- produces a histogram of the number of occurrences of each index within
571 -- a specified range:
572 --
573 -- > hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b
574 -- > hist bnds is = accumArray (+) 0 bnds [(i, 1) | i<-is, inRange bnds i]
575 --
576 -- If the accumulating function is strict, then 'accumArray' is strict in
577 -- the values, as well as the indices, in the association list. Thus,
578 -- unlike ordinary arrays built with 'array', accumulated arrays should
579 -- not in general be recursive.
580 {-# INLINE accumArray #-}
581 accumArray :: Ix i
582 => (e -> a -> e) -- ^ accumulating function
583 -> e -- ^ initial value
584 -> (i,i) -- ^ bounds of the array
585 -> [(i, a)] -- ^ association list
586 -> Array i e
587 accumArray f initial (l,u) ies =
588 let n = safeRangeSize (l,u)
589 in unsafeAccumArray' f initial (l,u) n
590 [(safeIndex (l,u) n i, e) | (i, e) <- ies]
591
592 {-# INLINE unsafeAccumArray #-}
593 unsafeAccumArray :: Ix i => (e -> a -> e) -> e -> (i,i) -> [(Int, a)] -> Array i e
594 unsafeAccumArray f initial b ies = unsafeAccumArray' f initial b (rangeSize b) ies
595
596 {-# INLINE unsafeAccumArray' #-}
597 unsafeAccumArray' :: Ix i => (e -> a -> e) -> e -> (i,i) -> Int -> [(Int, a)] -> Array i e
598 unsafeAccumArray' f initial (l,u) n@(I# n#) ies = runST (ST $ \s1# ->
599 case newArray# n# initial s1# of { (# s2#, marr# #) ->
600 foldr (adjust f marr#) (done l u n marr#) ies s2# })
601
602 {-# INLINE adjust #-}
603 adjust :: (e -> a -> e) -> MutableArray# s e -> (Int, a) -> STRep s b -> STRep s b
604 -- See NB on 'fill'
605 adjust f marr# (I# i#, new) next
606 = \s1# -> case readArray# marr# i# s1# of
607 (# s2#, old #) ->
608 case writeArray# marr# i# (f old new) s2# of
609 s3# -> next s3#
610
611 -- | Constructs an array identical to the first argument except that it has
612 -- been updated by the associations in the right argument.
613 -- For example, if @m@ is a 1-origin, @n@ by @n@ matrix, then
614 --
615 -- > m//[((i,i), 0) | i <- [1..n]]
616 --
617 -- is the same matrix, except with the diagonal zeroed.
618 --
619 -- Repeated indices in the association list are handled as for 'array':
620 -- Haskell 2010 specifies that the resulting array is undefined (i.e. bottom),
621 -- but GHC's implementation uses the last association for each index.
622 {-# INLINE (//) #-}
623 (//) :: Ix i => Array i e -> [(i, e)] -> Array i e
624 arr@(Array l u n _) // ies =
625 unsafeReplace arr [(safeIndex (l,u) n i, e) | (i, e) <- ies]
626
627 {-# INLINE unsafeReplace #-}
628 unsafeReplace :: Ix i => Array i e -> [(Int, e)] -> Array i e
629 unsafeReplace arr ies = runST (do
630 STArray l u n marr# <- thawSTArray arr
631 ST (foldr (fill marr#) (done l u n marr#) ies))
632
633 -- | @'accum' f@ takes an array and an association list and accumulates
634 -- pairs from the list into the array with the accumulating function @f@.
635 -- Thus 'accumArray' can be defined using 'accum':
636 --
637 -- > accumArray f z b = accum f (array b [(i, z) | i <- range b])
638 --
639 {-# INLINE accum #-}
640 accum :: Ix i => (e -> a -> e) -> Array i e -> [(i, a)] -> Array i e
641 accum f arr@(Array l u n _) ies =
642 unsafeAccum f arr [(safeIndex (l,u) n i, e) | (i, e) <- ies]
643
644 {-# INLINE unsafeAccum #-}
645 unsafeAccum :: Ix i => (e -> a -> e) -> Array i e -> [(Int, a)] -> Array i e
646 unsafeAccum f arr ies = runST (do
647 STArray l u n marr# <- thawSTArray arr
648 ST (foldr (adjust f marr#) (done l u n marr#) ies))
649
650 {-# INLINE amap #-}
651 amap :: Ix i => (a -> b) -> Array i a -> Array i b
652 amap f arr@(Array l u n _) =
653 unsafeArray' (l,u) n [(i, f (unsafeAt arr i)) | i <- [0 .. n - 1]]
654
655 -- | 'ixmap' allows for transformations on array indices.
656 -- It may be thought of as providing function composition on the right
657 -- with the mapping that the original array embodies.
658 --
659 -- A similar transformation of array values may be achieved using 'fmap'
660 -- from the 'Array' instance of the 'Functor' class.
661 {-# INLINE ixmap #-}
662 ixmap :: (Ix i, Ix j) => (i,i) -> (i -> j) -> Array j e -> Array i e
663 ixmap (l,u) f arr =
664 array (l,u) [(i, arr ! f i) | i <- range (l,u)]
665
666 {-# INLINE eqArray #-}
667 eqArray :: (Ix i, Eq e) => Array i e -> Array i e -> Bool
668 eqArray arr1@(Array l1 u1 n1 _) arr2@(Array l2 u2 n2 _) =
669 if n1 == 0 then n2 == 0 else
670 l1 == l2 && u1 == u2 &&
671 and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. n1 - 1]]
672
673 {-# INLINE [1] cmpArray #-}
674 cmpArray :: (Ix i, Ord e) => Array i e -> Array i e -> Ordering
675 cmpArray arr1 arr2 = compare (assocs arr1) (assocs arr2)
676
677 {-# INLINE cmpIntArray #-}
678 cmpIntArray :: Ord e => Array Int e -> Array Int e -> Ordering
679 cmpIntArray arr1@(Array l1 u1 n1 _) arr2@(Array l2 u2 n2 _) =
680 if n1 == 0 then
681 if n2 == 0 then EQ else LT
682 else if n2 == 0 then GT
683 else case compare l1 l2 of
684 EQ -> foldr cmp (compare u1 u2) [0 .. (n1 `min` n2) - 1]
685 other -> other
686 where
687 cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of
688 EQ -> rest
689 other -> other
690
691 {-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-}
692
693 ----------------------------------------------------------------------
694 -- Array instances
695
696 instance Ix i => Functor (Array i) where
697 fmap = amap
698
699 instance (Ix i, Eq e) => Eq (Array i e) where
700 (==) = eqArray
701
702 instance (Ix i, Ord e) => Ord (Array i e) where
703 compare = cmpArray
704
705 instance (Ix a, Show a, Show b) => Show (Array a b) where
706 showsPrec p a =
707 showParen (p > appPrec) $
708 showString "array " .
709 showsPrec appPrec1 (bounds a) .
710 showChar ' ' .
711 showsPrec appPrec1 (assocs a)
712 -- Precedence of 'array' is the precedence of application
713
714 -- The Read instance is in GHC.Read
715
716 ----------------------------------------------------------------------
717 -- Operations on mutable arrays
718
719 {-
720 Idle ADR question: What's the tradeoff here between flattening these
721 datatypes into @STArray ix ix (MutableArray# s elt)@ and using
722 it as is? As I see it, the former uses slightly less heap and
723 provides faster access to the individual parts of the bounds while the
724 code used has the benefit of providing a ready-made @(lo, hi)@ pair as
725 required by many array-related functions. Which wins? Is the
726 difference significant (probably not).
727
728 Idle AJG answer: When I looked at the outputted code (though it was 2
729 years ago) it seems like you often needed the tuple, and we build
730 it frequently. Now we've got the overloading specialiser things
731 might be different, though.
732 -}
733
734 {-# INLINE newSTArray #-}
735 newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)
736 newSTArray (l,u) initial = ST $ \s1# ->
737 case safeRangeSize (l,u) of { n@(I# n#) ->
738 case newArray# n# initial s1# of { (# s2#, marr# #) ->
739 (# s2#, STArray l u n marr# #) }}
740
741 {-# INLINE boundsSTArray #-}
742 boundsSTArray :: STArray s i e -> (i,i)
743 boundsSTArray (STArray l u _ _) = (l,u)
744
745 {-# INLINE numElementsSTArray #-}
746 numElementsSTArray :: STArray s i e -> Int
747 numElementsSTArray (STArray _ _ n _) = n
748
749 {-# INLINE readSTArray #-}
750 readSTArray :: Ix i => STArray s i e -> i -> ST s e
751 readSTArray marr@(STArray l u n _) i =
752 unsafeReadSTArray marr (safeIndex (l,u) n i)
753
754 {-# INLINE unsafeReadSTArray #-}
755 unsafeReadSTArray :: Ix i => STArray s i e -> Int -> ST s e
756 unsafeReadSTArray (STArray _ _ _ marr#) (I# i#)
757 = ST $ \s1# -> readArray# marr# i# s1#
758
759 {-# INLINE writeSTArray #-}
760 writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s ()
761 writeSTArray marr@(STArray l u n _) i e =
762 unsafeWriteSTArray marr (safeIndex (l,u) n i) e
763
764 {-# INLINE unsafeWriteSTArray #-}
765 unsafeWriteSTArray :: Ix i => STArray s i e -> Int -> e -> ST s ()
766 unsafeWriteSTArray (STArray _ _ _ marr#) (I# i#) e = ST $ \s1# ->
767 case writeArray# marr# i# e s1# of
768 s2# -> (# s2#, () #)
769
770 ----------------------------------------------------------------------
771 -- Moving between mutable and immutable
772
773 freezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)
774 freezeSTArray (STArray l u n@(I# n#) marr#) = ST $ \s1# ->
775 case newArray# n# arrEleBottom s1# of { (# s2#, marr'# #) ->
776 let copy i# s3# | isTrue# (i# ==# n#) = s3#
777 | otherwise =
778 case readArray# marr# i# s3# of { (# s4#, e #) ->
779 case writeArray# marr'# i# e s4# of { s5# ->
780 copy (i# +# 1#) s5# }} in
781 case copy 0# s2# of { s3# ->
782 case unsafeFreezeArray# marr'# s3# of { (# s4#, arr# #) ->
783 (# s4#, Array l u n arr# #) }}}
784
785 {-# INLINE unsafeFreezeSTArray #-}
786 unsafeFreezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)
787 unsafeFreezeSTArray (STArray l u n marr#) = ST $ \s1# ->
788 case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) ->
789 (# s2#, Array l u n arr# #) }
790
791 thawSTArray :: Ix i => Array i e -> ST s (STArray s i e)
792 thawSTArray (Array l u n@(I# n#) arr#) = ST $ \s1# ->
793 case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) ->
794 let copy i# s3# | isTrue# (i# ==# n#) = s3#
795 | otherwise =
796 case indexArray# arr# i# of { (# e #) ->
797 case writeArray# marr# i# e s3# of { s4# ->
798 copy (i# +# 1#) s4# }} in
799 case copy 0# s2# of { s3# ->
800 (# s3#, STArray l u n marr# #) }}
801
802 {-# INLINE unsafeThawSTArray #-}
803 unsafeThawSTArray :: Ix i => Array i e -> ST s (STArray s i e)
804 unsafeThawSTArray (Array l u n arr#) = ST $ \s1# ->
805 case unsafeThawArray# arr# s1# of { (# s2#, marr# #) ->
806 (# s2#, STArray l u n marr# #) }