GHC/Arr.lhs

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