GHC/Arr.lhs

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