GHC/Arr.lhs

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