GHC/Arr.lhs

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