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