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