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