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