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