Data/Array/Base.hs

   1 {-# OPTIONS_GHC -fno-bang-patterns #-}
   2
   3 -----------------------------------------------------------------------------
   4 -- |
   5 -- Module      :  Data.Array.Base
   6 -- Copyright   :  (c) The University of Glasgow 2001
   7 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   8 --
   9 -- Maintainer  :  libraries@haskell.org
  10 -- Stability   :  experimental
  11 -- Portability :  non-portable (MPTCs, uses Control.Monad.ST)
  12 --
  13 -- Basis for IArray and MArray.  Not intended for external consumption;
  14 -- use IArray or MArray instead.
  15 --
  16 -----------------------------------------------------------------------------
  17
  18 -- #hide
  19 module Data.Array.Base where
  20
  21 import Prelude
  22
  23 import Control.Monad.ST.Lazy ( strictToLazyST )
  24 import qualified Control.Monad.ST.Lazy as Lazy (ST)
  25 import Data.Ix          ( Ix, range, index, rangeSize )
  26 import Data.Int
  27 import Data.Word
  28 import Foreign.C.Types
  29 import Foreign.Ptr
  30 import Foreign.StablePtr
  31
  32 #ifdef __GLASGOW_HASKELL__
  33 import GHC.Arr          ( STArray, unsafeIndex )
  34 import qualified GHC.Arr as Arr
  35 import qualified GHC.Arr as ArrST
  36 import GHC.ST           ( ST(..), runST )
  37 import GHC.Base
  38 import GHC.Word         ( Word(..) )
  39 import GHC.Ptr          ( Ptr(..), FunPtr(..), nullPtr, nullFunPtr )
  40 import GHC.Float        ( Float(..), Double(..) )
  41 import GHC.Stable       ( StablePtr(..) )
  42 import GHC.Int          ( Int8(..),  Int16(..),  Int32(..),  Int64(..) )
  43 import GHC.Word         ( Word8(..), Word16(..), Word32(..), Word64(..) )
  44 import GHC.IOBase       ( IO(..) )
  45 #endif
  46
  47 #ifdef __HUGS__
  48 import Data.Bits
  49 import Foreign.Storable
  50 import qualified Hugs.Array as Arr
  51 import qualified Hugs.ST as ArrST
  52 import Hugs.Array ( unsafeIndex )
  53 import Hugs.ST ( STArray, ST(..), runST )
  54 import Hugs.ByteArray
  55 #endif
  56
  57 import Data.Typeable
  58 #include "Typeable.h"
  59
  60 #include "MachDeps.h"
  61
  62 -----------------------------------------------------------------------------
  63 -- Class of immutable arrays
  64
  65 {- | Class of immutable array types.
  66
  67 An array type has the form @(a i e)@ where @a@ is the array type
  68 constructor (kind @* -> * -> *@), @i@ is the index type (a member of
  69 the class 'Ix'), and @e@ is the element type.  The @IArray@ class is
  70 parameterised over both @a@ and @e@, so that instances specialised to
  71 certain element types can be defined.
  72 -}
  73 class IArray a e where
  74     -- | Extracts the bounds of an immutable array
  75     bounds           :: Ix i => a i e -> (i,i)
  76     unsafeArray      :: Ix i => (i,i) -> [(Int, e)] -> a i e
  77     unsafeAt         :: Ix i => a i e -> Int -> e
  78     unsafeReplace    :: Ix i => a i e -> [(Int, e)] -> a i e
  79     unsafeAccum      :: Ix i => (e -> e' -> e) -> a i e -> [(Int, e')] -> a i e
  80     unsafeAccumArray :: Ix i => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> a i e
  81
  82     unsafeReplace arr ies = runST (unsafeReplaceST arr ies >>= unsafeFreeze)
  83     unsafeAccum f arr ies = runST (unsafeAccumST f arr ies >>= unsafeFreeze)
  84     unsafeAccumArray f e lu ies = runST (unsafeAccumArrayST f e lu ies >>= unsafeFreeze)
  85
  86 {-# INLINE unsafeReplaceST #-}
  87 unsafeReplaceST :: (IArray a e, Ix i) => a i e -> [(Int, e)] -> ST s (STArray s i e)
  88 unsafeReplaceST arr ies = do
  89     marr <- thaw arr
  90     sequence_ [unsafeWrite marr i e | (i, e) <- ies]
  91     return marr
  92
  93 {-# INLINE unsafeAccumST #-}
  94 unsafeAccumST :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(Int, e')] -> ST s (STArray s i e)
  95 unsafeAccumST f arr ies = do
  96     marr <- thaw arr
  97     sequence_ [do
  98         old <- unsafeRead marr i
  99         unsafeWrite marr i (f old new)
 100         | (i, new) <- ies]
 101     return marr
 102
 103 {-# INLINE unsafeAccumArrayST #-}
 104 unsafeAccumArrayST :: Ix i => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (STArray s i e)
 105 unsafeAccumArrayST f e (l,u) ies = do
 106     marr <- newArray (l,u) e
 107     sequence_ [do
 108         old <- unsafeRead marr i
 109         unsafeWrite marr i (f old new)
 110         | (i, new) <- ies]
 111     return marr
 112
 113
 114 {-# INLINE array #-}
 115
 116 {-| Constructs an immutable array from a pair of bounds and a list of
 117 initial associations.
 118
 119 The bounds are specified as a pair of the lowest and highest bounds in
 120 the array respectively.  For example, a one-origin vector of length 10
 121 has bounds (1,10), and a one-origin 10 by 10 matrix has bounds
 122 ((1,1),(10,10)).
 123
 124 An association is a pair of the form @(i,x)@, which defines the value of
 125 the array at index @i@ to be @x@.  The array is undefined if any index
 126 in the list is out of bounds.  If any two associations in the list have
 127 the same index, the value at that index is implementation-dependent.
 128 (In GHC, the last value specified for that index is used.
 129 Other implementations will also do this for unboxed arrays, but Haskell
 130 98 requires that for 'Array' the value at such indices is bottom.)
 131
 132 Because the indices must be checked for these errors, 'array' is
 133 strict in the bounds argument and in the indices of the association
 134 list.  Whether @array@ is strict or non-strict in the elements depends
 135 on the array type: 'Data.Array.Array' is a non-strict array type, but
 136 all of the 'Data.Array.Unboxed.UArray' arrays are strict.  Thus in a
 137 non-strict array, recurrences such as the following are possible:
 138
 139 > a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i \<- [2..100]])
 140
 141 Not every index within the bounds of the array need appear in the
 142 association list, but the values associated with indices that do not
 143 appear will be undefined.
 144
 145 If, in any dimension, the lower bound is greater than the upper bound,
 146 then the array is legal, but empty. Indexing an empty array always
 147 gives an array-bounds error, but 'bounds' still yields the bounds with
 148 which the array was constructed.
 149 -}
 150 array   :: (IArray a e, Ix i)
 151         => (i,i)        -- ^ bounds of the array: (lowest,highest)
 152         -> [(i, e)]     -- ^ list of associations
 153         -> a i e
 154 array (l,u) ies = unsafeArray (l,u) [(index (l,u) i, e) | (i, e) <- ies]
 155
 156 -- Since unsafeFreeze is not guaranteed to be only a cast, we will
 157 -- use unsafeArray and zip instead of a specialized loop to implement
 158 -- listArray, unlike Array.listArray, even though it generates some
 159 -- unnecessary heap allocation. Will use the loop only when we have
 160 -- fast unsafeFreeze, namely for Array and UArray (well, they cover
 161 -- almost all cases).
 162
 163 {-# INLINE listArray #-}
 164
 165 -- | Constructs an immutable array from a list of initial elements.
 166 -- The list gives the elements of the array in ascending order
 167 -- beginning with the lowest index.
 168 listArray :: (IArray a e, Ix i) => (i,i) -> [e] -> a i e
 169 listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es)
 170
 171 {-# INLINE listArrayST #-}
 172 listArrayST :: Ix i => (i,i) -> [e] -> ST s (STArray s i e)
 173 listArrayST (l,u) es = do
 174     marr <- newArray_ (l,u)
 175     let n = rangeSize (l,u)
 176     let fillFromList i xs | i == n    = return ()
 177                           | otherwise = case xs of
 178             []   -> return ()
 179             y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys
 180     fillFromList 0 es
 181     return marr
 182
 183 {-# RULES
 184 "listArray/Array" listArray =
 185     \lu es -> runST (listArrayST lu es >>= ArrST.unsafeFreezeSTArray)
 186     #-}
 187
 188 {-# INLINE listUArrayST #-}
 189 listUArrayST :: (MArray (STUArray s) e (ST s), Ix i)
 190              => (i,i) -> [e] -> ST s (STUArray s i e)
 191 listUArrayST (l,u) es = do
 192     marr <- newArray_ (l,u)
 193     let n = rangeSize (l,u)
 194     let fillFromList i xs | i == n    = return ()
 195                           | otherwise = case xs of
 196             []   -> return ()
 197             y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys
 198     fillFromList 0 es
 199     return marr
 200
 201 -- I don't know how to write a single rule for listUArrayST, because
 202 -- the type looks like constrained over 's', which runST doesn't
 203 -- like. In fact all MArray (STUArray s) instances are polymorphic
 204 -- wrt. 's', but runST can't know that.
 205 --
 206 -- More precisely, we'd like to write this:
 207 --   listUArray :: (forall s. MArray (STUArray s) e (ST s), Ix i)
 208 --              => (i,i) -> [e] -> UArray i e
 209 --   listUArray lu = runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
 210 --   {-# RULES listArray = listUArray
 211 -- Then we could call listUArray at any type 'e' that had a suitable
 212 -- MArray instance.  But sadly we can't, because we don't have quantified
 213 -- constraints.  Hence the mass of rules below.
 214
 215 -- I would like also to write a rule for listUArrayST (or listArray or
 216 -- whatever) applied to unpackCString#. Unfortunately unpackCString#
 217 -- calls seem to be floated out, then floated back into the middle
 218 -- of listUArrayST, so I was not able to do this.
 219
 220 #ifdef __GLASGOW_HASKELL__
 221 type ListUArray e = forall i . Ix i => (i,i) -> [e] -> UArray i e
 222
 223 {-# RULES
 224 "listArray/UArray/Bool"      listArray
 225    = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Bool
 226 "listArray/UArray/Char"      listArray
 227    = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Char
 228 "listArray/UArray/Int"       listArray
 229    = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int
 230 "listArray/UArray/Word"      listArray
 231    = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word
 232 "listArray/UArray/Ptr"       listArray
 233    = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (Ptr a)
 234 "listArray/UArray/FunPtr"    listArray
 235    = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (FunPtr a)
 236 "listArray/UArray/Float"     listArray
 237    = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Float
 238 "listArray/UArray/Double"    listArray
 239    = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Double
 240 "listArray/UArray/StablePtr" listArray
 241    = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (StablePtr a)
 242 "listArray/UArray/Int8"      listArray
 243    = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int8
 244 "listArray/UArray/Int16"     listArray
 245    = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int16
 246 "listArray/UArray/Int32"     listArray
 247    = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int32
 248 "listArray/UArray/Int64"     listArray
 249    = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int64
 250 "listArray/UArray/Word8"     listArray
 251    = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word8
 252 "listArray/UArray/Word16"    listArray
 253    = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word16
 254 "listArray/UArray/Word32"    listArray
 255    = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word32
 256 "listArray/UArray/Word64"    listArray
 257    = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word64
 258     #-}
 259 #endif
 260
 261 {-# INLINE (!) #-}
 262 -- | Returns the element of an immutable array at the specified index.
 263 (!) :: (IArray a e, Ix i) => a i e -> i -> e
 264 arr ! i = case bounds arr of (l,u) -> unsafeAt arr (index (l,u) i)
 265
 266 {-# INLINE indices #-}
 267 -- | Returns a list of all the valid indices in an array.
 268 indices :: (IArray a e, Ix i) => a i e -> [i]
 269 indices arr = case bounds arr of (l,u) -> range (l,u)
 270
 271 {-# INLINE elems #-}
 272 -- | Returns a list of all the elements of an array, in the same order
 273 -- as their indices.
 274 elems :: (IArray a e, Ix i) => a i e -> [e]
 275 elems arr = case bounds arr of
 276     (l,u) -> [unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]]
 277
 278 {-# INLINE assocs #-}
 279 -- | Returns the contents of an array as a list of associations.
 280 assocs :: (IArray a e, Ix i) => a i e -> [(i, e)]
 281 assocs arr = case bounds arr of
 282     (l,u) -> [(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)]
 283
 284 {-# INLINE accumArray #-}
 285
 286 {-|
 287 Constructs an immutable array from a list of associations.  Unlike
 288 'array', the same index is allowed to occur multiple times in the list
 289 of associations; an /accumulating function/ is used to combine the
 290 values of elements with the same index.
 291
 292 For example, given a list of values of some index type, hist produces
 293 a histogram of the number of occurrences of each index within a
 294 specified range:
 295
 296 > hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b
 297 > hist bnds is = accumArray (+) 0 bnds [(i, 1) | i\<-is, inRange bnds i]
 298 -}
 299 accumArray :: (IArray a e, Ix i)
 300         => (e -> e' -> e)       -- ^ An accumulating function
 301         -> e                    -- ^ A default element
 302         -> (i,i)                -- ^ The bounds of the array
 303         -> [(i, e')]            -- ^ List of associations
 304         -> a i e                -- ^ Returns: the array
 305 accumArray f init (l,u) ies =
 306     unsafeAccumArray f init (l,u) [(index (l,u) i, e) | (i, e) <- ies]
 307
 308 {-# INLINE (//) #-}
 309 {-|
 310 Takes an array and a list of pairs and returns an array identical to
 311 the left argument except that it has been updated by the associations
 312 in the right argument.  For example, if m is a 1-origin, n by n matrix,
 313 then @m\/\/[((i,i), 0) | i \<- [1..n]]@ is the same matrix, except with
 314 the diagonal zeroed.
 315
 316 As with the 'array' function, if any two associations in the list have
 317 the same index, the value at that index is implementation-dependent.
 318 (In GHC, the last value specified for that index is used.
 319 Other implementations will also do this for unboxed arrays, but Haskell
 320 98 requires that for 'Array' the value at such indices is bottom.)
 321
 322 For most array types, this operation is O(/n/) where /n/ is the size
 323 of the array.  However, the 'Data.Array.Diff.DiffArray' type provides
 324 this operation with complexity linear in the number of updates.
 325 -}
 326 (//) :: (IArray a e, Ix i) => a i e -> [(i, e)] -> a i e
 327 arr // ies = case bounds arr of
 328     (l,u) -> unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies]
 329
 330 {-# INLINE accum #-}
 331 {-|
 332 @accum f@ takes an array and an association list and accumulates pairs
 333 from the list into the array with the accumulating function @f@. Thus
 334 'accumArray' can be defined using 'accum':
 335
 336 > accumArray f z b = accum f (array b [(i, z) | i \<- range b])
 337 -}
 338 accum :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(i, e')] -> a i e
 339 accum f arr ies = case bounds arr of
 340     (l,u) -> unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies]
 341
 342 {-# INLINE amap #-}
 343 -- | Returns a new array derived from the original array by applying a
 344 -- function to each of the elements.
 345 amap :: (IArray a e', IArray a e, Ix i) => (e' -> e) -> a i e' -> a i e
 346 amap f arr = case bounds arr of
 347     (l,u) -> unsafeArray (l,u) [(i, f (unsafeAt arr i)) |
 348                                 i <- [0 .. rangeSize (l,u) - 1]]
 349 {-# INLINE ixmap #-}
 350 -- | Returns a new array derived from the original array by applying a
 351 -- function to each of the indices.
 352 ixmap :: (IArray a e, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> a i e
 353 ixmap (l,u) f arr =
 354     unsafeArray (l,u) [(unsafeIndex (l,u) i, arr ! f i) | i <- range (l,u)]
 355
 356 -----------------------------------------------------------------------------
 357 -- Normal polymorphic arrays
 358
 359 instance IArray Arr.Array e where
 360     {-# INLINE bounds #-}
 361     bounds = Arr.bounds
 362     {-# INLINE unsafeArray #-}
 363     unsafeArray      = Arr.unsafeArray
 364     {-# INLINE unsafeAt #-}
 365     unsafeAt         = Arr.unsafeAt
 366     {-# INLINE unsafeReplace #-}
 367     unsafeReplace    = Arr.unsafeReplace
 368     {-# INLINE unsafeAccum #-}
 369     unsafeAccum      = Arr.unsafeAccum
 370     {-# INLINE unsafeAccumArray #-}
 371     unsafeAccumArray = Arr.unsafeAccumArray
 372
 373 -----------------------------------------------------------------------------
 374 -- Flat unboxed arrays
 375
 376 -- | Arrays with unboxed elements.  Instances of 'IArray' are provided
 377 -- for 'UArray' with certain element types ('Int', 'Float', 'Char',
 378 -- etc.; see the 'UArray' class for a full list).
 379 --
 380 -- A 'UArray' will generally be more efficient (in terms of both time
 381 -- and space) than the equivalent 'Data.Array.Array' with the same
 382 -- element type.  However, 'UArray' is strict in its elements - so
 383 -- don\'t use 'UArray' if you require the non-strictness that
 384 -- 'Data.Array.Array' provides.
 385 --
 386 -- Because the @IArray@ interface provides operations overloaded on
 387 -- the type of the array, it should be possible to just change the
 388 -- array type being used by a program from say @Array@ to @UArray@ to
 389 -- get the benefits of unboxed arrays (don\'t forget to import
 390 -- "Data.Array.Unboxed" instead of "Data.Array").
 391 --
 392 #ifdef __GLASGOW_HASKELL__
 393 data UArray i e = UArray !i !i ByteArray#
 394 #endif
 395 #ifdef __HUGS__
 396 data UArray i e = UArray !i !i !ByteArray
 397 #endif
 398
 399 INSTANCE_TYPEABLE2(UArray,uArrayTc,"UArray")
 400
 401 {-# INLINE unsafeArrayUArray #-}
 402 unsafeArrayUArray :: (MArray (STUArray s) e (ST s), Ix i)
 403                   => (i,i) -> [(Int, e)] -> e -> ST s (UArray i e)
 404 unsafeArrayUArray (l,u) ies default_elem = do
 405     marr <- newArray (l,u) default_elem
 406     sequence_ [unsafeWrite marr i e | (i, e) <- ies]
 407     unsafeFreezeSTUArray marr
 408
 409 #ifdef __GLASGOW_HASKELL__
 410 {-# INLINE unsafeFreezeSTUArray #-}
 411 unsafeFreezeSTUArray :: STUArray s i e -> ST s (UArray i e)
 412 unsafeFreezeSTUArray (STUArray l u marr#) = ST $ \s1# ->
 413     case unsafeFreezeByteArray# marr# s1# of { (# s2#, arr# #) ->
 414     (# s2#, UArray l u arr# #) }
 415 #endif
 416
 417 #ifdef __HUGS__
 418 unsafeFreezeSTUArray :: STUArray s i e -> ST s (UArray i e)
 419 unsafeFreezeSTUArray (STUArray l u marr) = do
 420     arr <- unsafeFreezeMutableByteArray marr
 421     return (UArray l u arr)
 422 #endif
 423
 424 {-# INLINE unsafeReplaceUArray #-}
 425 unsafeReplaceUArray :: (MArray (STUArray s) e (ST s), Ix i)
 426                     => UArray i e -> [(Int, e)] -> ST s (UArray i e)
 427 unsafeReplaceUArray arr ies = do
 428     marr <- thawSTUArray arr
 429     sequence_ [unsafeWrite marr i e | (i, e) <- ies]
 430     unsafeFreezeSTUArray marr
 431
 432 {-# INLINE unsafeAccumUArray #-}
 433 unsafeAccumUArray :: (MArray (STUArray s) e (ST s), Ix i)
 434                   => (e -> e' -> e) -> UArray i e -> [(Int, e')] -> ST s (UArray i e)
 435 unsafeAccumUArray f arr ies = do
 436     marr <- thawSTUArray arr
 437     sequence_ [do
 438         old <- unsafeRead marr i
 439         unsafeWrite marr i (f old new)
 440         | (i, new) <- ies]
 441     unsafeFreezeSTUArray marr
 442
 443 {-# INLINE unsafeAccumArrayUArray #-}
 444 unsafeAccumArrayUArray :: (MArray (STUArray s) e (ST s), Ix i)
 445                        => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (UArray i e)
 446 unsafeAccumArrayUArray f init (l,u) ies = do
 447     marr <- newArray (l,u) init
 448     sequence_ [do
 449         old <- unsafeRead marr i
 450         unsafeWrite marr i (f old new)
 451         | (i, new) <- ies]
 452     unsafeFreezeSTUArray marr
 453
 454 {-# INLINE eqUArray #-}
 455 eqUArray :: (IArray UArray e, Ix i, Eq e) => UArray i e -> UArray i e -> Bool
 456 eqUArray arr1@(UArray l1 u1 _) arr2@(UArray l2 u2 _) =
 457     if rangeSize (l1,u1) == 0 then rangeSize (l2,u2) == 0 else
 458     l1 == l2 && u1 == u2 &&
 459     and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. rangeSize (l1,u1) - 1]]
 460
 461 {-# INLINE cmpUArray #-}
 462 cmpUArray :: (IArray UArray e, Ix i, Ord e) => UArray i e -> UArray i e -> Ordering
 463 cmpUArray arr1 arr2 = compare (assocs arr1) (assocs arr2)
 464
 465 {-# INLINE cmpIntUArray #-}
 466 cmpIntUArray :: (IArray UArray e, Ord e) => UArray Int e -> UArray Int e -> Ordering
 467 cmpIntUArray arr1@(UArray l1 u1 _) arr2@(UArray l2 u2 _) =
 468     if rangeSize (l1,u1) == 0 then if rangeSize (l2,u2) == 0 then EQ else LT else
 469     if rangeSize (l2,u2) == 0 then GT else
 470     case compare l1 l2 of
 471         EQ    -> foldr cmp (compare u1 u2) [0 .. rangeSize (l1, min u1 u2) - 1]
 472         other -> other
 473     where
 474     cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of
 475         EQ    -> rest
 476         other -> other
 477
 478 {-# RULES "cmpUArray/Int" cmpUArray = cmpIntUArray #-}
 479
 480 -----------------------------------------------------------------------------
 481 -- Showing IArrays
 482
 483 {-# SPECIALISE
 484     showsIArray :: (IArray UArray e, Ix i, Show i, Show e) =>
 485                    Int -> UArray i e -> ShowS
 486   #-}
 487
 488 showsIArray :: (IArray a e, Ix i, Show i, Show e) => Int -> a i e -> ShowS
 489 showsIArray p a =
 490     showParen (p > 9) $
 491     showString "array " .
 492     shows (bounds a) .
 493     showChar ' ' .
 494     shows (assocs a)
 495
 496 -----------------------------------------------------------------------------
 497 -- Flat unboxed arrays: instances
 498
 499 #ifdef __HUGS__
 500 unsafeAtBArray :: Storable e => UArray i e -> Int -> e
 501 unsafeAtBArray (UArray _ _ arr) = readByteArray arr
 502 #endif
 503
 504 instance IArray UArray Bool where
 505     {-# INLINE bounds #-}
 506     bounds (UArray l u _) = (l,u)
 507     {-# INLINE unsafeArray #-}
 508     unsafeArray lu ies = runST (unsafeArrayUArray lu ies False)
 509 #ifdef __GLASGOW_HASKELL__
 510     {-# INLINE unsafeAt #-}
 511     unsafeAt (UArray _ _ arr#) (I# i#) =
 512         (indexWordArray# arr# (bOOL_INDEX i#) `and#` bOOL_BIT i#)
 513         `neWord#` int2Word# 0#
 514 #endif
 515 #ifdef __HUGS__
 516     unsafeAt (UArray _ _ arr) i =
 517         testBit (readByteArray arr (bOOL_INDEX i)::BitSet) (bOOL_SUBINDEX i)
 518 #endif
 519     {-# INLINE unsafeReplace #-}
 520     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 521     {-# INLINE unsafeAccum #-}
 522     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 523     {-# INLINE unsafeAccumArray #-}
 524     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 525
 526 instance IArray UArray Char where
 527     {-# INLINE bounds #-}
 528     bounds (UArray l u _) = (l,u)
 529     {-# INLINE unsafeArray #-}
 530     unsafeArray lu ies = runST (unsafeArrayUArray lu ies '\0')
 531     {-# INLINE unsafeAt #-}
 532 #ifdef __GLASGOW_HASKELL__
 533     unsafeAt (UArray _ _ arr#) (I# i#) = C# (indexWideCharArray# arr# i#)
 534 #endif
 535 #ifdef __HUGS__
 536     unsafeAt = unsafeAtBArray
 537 #endif
 538     {-# INLINE unsafeReplace #-}
 539     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 540     {-# INLINE unsafeAccum #-}
 541     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 542     {-# INLINE unsafeAccumArray #-}
 543     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 544
 545 instance IArray UArray Int where
 546     {-# INLINE bounds #-}
 547     bounds (UArray l u _) = (l,u)
 548     {-# INLINE unsafeArray #-}
 549     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 550 #ifdef __GLASGOW_HASKELL__
 551     {-# INLINE unsafeAt #-}
 552     unsafeAt (UArray _ _ arr#) (I# i#) = I# (indexIntArray# arr# i#)
 553 #endif
 554 #ifdef __HUGS__
 555     unsafeAt = unsafeAtBArray
 556 #endif
 557     {-# INLINE unsafeReplace #-}
 558     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 559     {-# INLINE unsafeAccum #-}
 560     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 561     {-# INLINE unsafeAccumArray #-}
 562     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 563
 564 instance IArray UArray Word where
 565     {-# INLINE bounds #-}
 566     bounds (UArray l u _) = (l,u)
 567     {-# INLINE unsafeArray #-}
 568     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 569 #ifdef __GLASGOW_HASKELL__
 570     {-# INLINE unsafeAt #-}
 571     unsafeAt (UArray _ _ arr#) (I# i#) = W# (indexWordArray# arr# i#)
 572 #endif
 573 #ifdef __HUGS__
 574     unsafeAt = unsafeAtBArray
 575 #endif
 576     {-# INLINE unsafeReplace #-}
 577     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 578     {-# INLINE unsafeAccum #-}
 579     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 580     {-# INLINE unsafeAccumArray #-}
 581     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 582
 583 instance IArray UArray (Ptr a) where
 584     {-# INLINE bounds #-}
 585     bounds (UArray l u _) = (l,u)
 586     {-# INLINE unsafeArray #-}
 587     unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullPtr)
 588     {-# INLINE unsafeAt #-}
 589 #ifdef __GLASGOW_HASKELL__
 590     unsafeAt (UArray _ _ arr#) (I# i#) = Ptr (indexAddrArray# arr# i#)
 591 #endif
 592 #ifdef __HUGS__
 593     unsafeAt = unsafeAtBArray
 594 #endif
 595     {-# INLINE unsafeReplace #-}
 596     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 597     {-# INLINE unsafeAccum #-}
 598     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 599     {-# INLINE unsafeAccumArray #-}
 600     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 601
 602 instance IArray UArray (FunPtr a) where
 603     {-# INLINE bounds #-}
 604     bounds (UArray l u _) = (l,u)
 605     {-# INLINE unsafeArray #-}
 606     unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullFunPtr)
 607 #ifdef __GLASGOW_HASKELL__
 608     {-# INLINE unsafeAt #-}
 609     unsafeAt (UArray _ _ arr#) (I# i#) = FunPtr (indexAddrArray# arr# i#)
 610 #endif
 611 #ifdef __HUGS__
 612     unsafeAt = unsafeAtBArray
 613 #endif
 614     {-# INLINE unsafeReplace #-}
 615     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 616     {-# INLINE unsafeAccum #-}
 617     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 618     {-# INLINE unsafeAccumArray #-}
 619     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 620
 621 instance IArray UArray Float where
 622     {-# INLINE bounds #-}
 623     bounds (UArray l u _) = (l,u)
 624     {-# INLINE unsafeArray #-}
 625     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 626 #ifdef __GLASGOW_HASKELL__
 627     {-# INLINE unsafeAt #-}
 628     unsafeAt (UArray _ _ arr#) (I# i#) = F# (indexFloatArray# arr# i#)
 629 #endif
 630 #ifdef __HUGS__
 631     unsafeAt = unsafeAtBArray
 632 #endif
 633     {-# INLINE unsafeReplace #-}
 634     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 635     {-# INLINE unsafeAccum #-}
 636     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 637     {-# INLINE unsafeAccumArray #-}
 638     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 639
 640 instance IArray UArray Double where
 641     {-# INLINE bounds #-}
 642     bounds (UArray l u _) = (l,u)
 643     {-# INLINE unsafeArray #-}
 644     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 645 #ifdef __GLASGOW_HASKELL__
 646     {-# INLINE unsafeAt #-}
 647     unsafeAt (UArray _ _ arr#) (I# i#) = D# (indexDoubleArray# arr# i#)
 648 #endif
 649 #ifdef __HUGS__
 650     unsafeAt = unsafeAtBArray
 651 #endif
 652     {-# INLINE unsafeReplace #-}
 653     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 654     {-# INLINE unsafeAccum #-}
 655     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 656     {-# INLINE unsafeAccumArray #-}
 657     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 658
 659 instance IArray UArray (StablePtr a) where
 660     {-# INLINE bounds #-}
 661     bounds (UArray l u _) = (l,u)
 662     {-# INLINE unsafeArray #-}
 663     unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullStablePtr)
 664 #ifdef __GLASGOW_HASKELL__
 665     {-# INLINE unsafeAt #-}
 666     unsafeAt (UArray _ _ arr#) (I# i#) = StablePtr (indexStablePtrArray# arr# i#)
 667 #endif
 668 #ifdef __HUGS__
 669     unsafeAt = unsafeAtBArray
 670 #endif
 671     {-# INLINE unsafeReplace #-}
 672     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 673     {-# INLINE unsafeAccum #-}
 674     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 675     {-# INLINE unsafeAccumArray #-}
 676     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 677
 678 -- bogus StablePtr value for initialising a UArray of StablePtr.
 679 #ifdef __GLASGOW_HASKELL__
 680 nullStablePtr = StablePtr (unsafeCoerce# 0#)
 681 #endif
 682 #ifdef __HUGS__
 683 nullStablePtr = castPtrToStablePtr nullPtr
 684 #endif
 685
 686 instance IArray UArray Int8 where
 687     {-# INLINE bounds #-}
 688     bounds (UArray l u _) = (l,u)
 689     {-# INLINE unsafeArray #-}
 690     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 691 #ifdef __GLASGOW_HASKELL__
 692     {-# INLINE unsafeAt #-}
 693     unsafeAt (UArray _ _ arr#) (I# i#) = I8# (indexInt8Array# arr# i#)
 694 #endif
 695 #ifdef __HUGS__
 696     unsafeAt = unsafeAtBArray
 697 #endif
 698     {-# INLINE unsafeReplace #-}
 699     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 700     {-# INLINE unsafeAccum #-}
 701     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 702     {-# INLINE unsafeAccumArray #-}
 703     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 704
 705 instance IArray UArray Int16 where
 706     {-# INLINE bounds #-}
 707     bounds (UArray l u _) = (l,u)
 708     {-# INLINE unsafeArray #-}
 709     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 710 #ifdef __GLASGOW_HASKELL__
 711     {-# INLINE unsafeAt #-}
 712     unsafeAt (UArray _ _ arr#) (I# i#) = I16# (indexInt16Array# arr# i#)
 713 #endif
 714 #ifdef __HUGS__
 715     unsafeAt = unsafeAtBArray
 716 #endif
 717     {-# INLINE unsafeReplace #-}
 718     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 719     {-# INLINE unsafeAccum #-}
 720     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 721     {-# INLINE unsafeAccumArray #-}
 722     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 723
 724 instance IArray UArray Int32 where
 725     {-# INLINE bounds #-}
 726     bounds (UArray l u _) = (l,u)
 727     {-# INLINE unsafeArray #-}
 728     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 729 #ifdef __GLASGOW_HASKELL__
 730     {-# INLINE unsafeAt #-}
 731     unsafeAt (UArray _ _ arr#) (I# i#) = I32# (indexInt32Array# arr# i#)
 732 #endif
 733 #ifdef __HUGS__
 734     unsafeAt = unsafeAtBArray
 735 #endif
 736     {-# INLINE unsafeReplace #-}
 737     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 738     {-# INLINE unsafeAccum #-}
 739     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 740     {-# INLINE unsafeAccumArray #-}
 741     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 742
 743 instance IArray UArray Int64 where
 744     {-# INLINE bounds #-}
 745     bounds (UArray l u _) = (l,u)
 746     {-# INLINE unsafeArray #-}
 747     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 748 #ifdef __GLASGOW_HASKELL__
 749     {-# INLINE unsafeAt #-}
 750     unsafeAt (UArray _ _ arr#) (I# i#) = I64# (indexInt64Array# arr# i#)
 751 #endif
 752 #ifdef __HUGS__
 753     unsafeAt = unsafeAtBArray
 754 #endif
 755     {-# INLINE unsafeReplace #-}
 756     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 757     {-# INLINE unsafeAccum #-}
 758     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 759     {-# INLINE unsafeAccumArray #-}
 760     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 761
 762 instance IArray UArray Word8 where
 763     {-# INLINE bounds #-}
 764     bounds (UArray l u _) = (l,u)
 765     {-# INLINE unsafeArray #-}
 766     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 767 #ifdef __GLASGOW_HASKELL__
 768     {-# INLINE unsafeAt #-}
 769     unsafeAt (UArray _ _ arr#) (I# i#) = W8# (indexWord8Array# arr# i#)
 770 #endif
 771 #ifdef __HUGS__
 772     unsafeAt = unsafeAtBArray
 773 #endif
 774     {-# INLINE unsafeReplace #-}
 775     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 776     {-# INLINE unsafeAccum #-}
 777     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 778     {-# INLINE unsafeAccumArray #-}
 779     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 780
 781 instance IArray UArray Word16 where
 782     {-# INLINE bounds #-}
 783     bounds (UArray l u _) = (l,u)
 784     {-# INLINE unsafeArray #-}
 785     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 786 #ifdef __GLASGOW_HASKELL__
 787     {-# INLINE unsafeAt #-}
 788     unsafeAt (UArray _ _ arr#) (I# i#) = W16# (indexWord16Array# arr# i#)
 789 #endif
 790 #ifdef __HUGS__
 791     unsafeAt = unsafeAtBArray
 792 #endif
 793     {-# INLINE unsafeReplace #-}
 794     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 795     {-# INLINE unsafeAccum #-}
 796     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 797     {-# INLINE unsafeAccumArray #-}
 798     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 799
 800 instance IArray UArray Word32 where
 801     {-# INLINE bounds #-}
 802     bounds (UArray l u _) = (l,u)
 803     {-# INLINE unsafeArray #-}
 804     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 805 #ifdef __GLASGOW_HASKELL__
 806     {-# INLINE unsafeAt #-}
 807     unsafeAt (UArray _ _ arr#) (I# i#) = W32# (indexWord32Array# arr# i#)
 808 #endif
 809 #ifdef __HUGS__
 810     unsafeAt = unsafeAtBArray
 811 #endif
 812     {-# INLINE unsafeReplace #-}
 813     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 814     {-# INLINE unsafeAccum #-}
 815     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 816     {-# INLINE unsafeAccumArray #-}
 817     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 818
 819 instance IArray UArray Word64 where
 820     {-# INLINE bounds #-}
 821     bounds (UArray l u _) = (l,u)
 822     {-# INLINE unsafeArray #-}
 823     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 824 #ifdef __GLASGOW_HASKELL__
 825     {-# INLINE unsafeAt #-}
 826     unsafeAt (UArray _ _ arr#) (I# i#) = W64# (indexWord64Array# arr# i#)
 827 #endif
 828 #ifdef __HUGS__
 829     unsafeAt = unsafeAtBArray
 830 #endif
 831     {-# INLINE unsafeReplace #-}
 832     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 833     {-# INLINE unsafeAccum #-}
 834     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 835     {-# INLINE unsafeAccumArray #-}
 836     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 837
 838 instance (Ix ix, Eq e, IArray UArray e) => Eq (UArray ix e) where
 839     (==) = eqUArray
 840
 841 instance (Ix ix, Ord e, IArray UArray e) => Ord (UArray ix e) where
 842     compare = cmpUArray
 843
 844 instance (Ix ix, Show ix, Show e, IArray UArray e) => Show (UArray ix e) where
 845     showsPrec = showsIArray
 846
 847 -----------------------------------------------------------------------------
 848 -- Mutable arrays
 849
 850 {-# NOINLINE arrEleBottom #-}
 851 arrEleBottom :: a
 852 arrEleBottom = error "MArray: undefined array element"
 853
 854 {-| Class of mutable array types.
 855
 856 An array type has the form @(a i e)@ where @a@ is the array type
 857 constructor (kind @* -> * -> *@), @i@ is the index type (a member of
 858 the class 'Ix'), and @e@ is the element type.
 859
 860 The @MArray@ class is parameterised over both @a@ and @e@ (so that
 861 instances specialised to certain element types can be defined, in the
 862 same way as for 'IArray'), and also over the type of the monad, @m@,
 863 in which the mutable array will be manipulated.
 864 -}
 865 class (Monad m) => MArray a e m where
 866
 867     -- | Returns the bounds of the array
 868     getBounds   :: Ix i => a i e -> m (i,i)
 869
 870     -- | Builds a new array, with every element initialised to the supplied
 871     -- value.
 872     newArray    :: Ix i => (i,i) -> e -> m (a i e)
 873
 874     -- | Builds a new array, with every element initialised to an
 875     -- undefined value. In a monadic context in which operations must
 876     -- be deterministic (e.g. the ST monad), the array elements are
 877     -- initialised to a fixed but undefined value, such as zero.
 878     newArray_ :: Ix i => (i,i) -> m (a i e)
 879
 880     -- | Builds a new array, with every element initialised to an undefined
 881     -- value.
 882     unsafeNewArray_ :: Ix i => (i,i) -> m (a i e)
 883
 884     unsafeRead  :: Ix i => a i e -> Int -> m e
 885     unsafeWrite :: Ix i => a i e -> Int -> e -> m ()
 886
 887     {-# INLINE newArray #-}
 888         -- The INLINE is crucial, because until we know at least which monad
 889         -- we are in, the code below allocates like crazy.  So inline it,
 890         -- in the hope that the context will know the monad.
 891     newArray (l,u) init = do
 892         marr <- unsafeNewArray_ (l,u)
 893         sequence_ [unsafeWrite marr i init | i <- [0 .. rangeSize (l,u) - 1]]
 894         return marr
 895
 896     {-# INLINE unsafeNewArray_ #-}
 897     unsafeNewArray_ (l,u) = newArray (l,u) arrEleBottom
 898
 899     {-# INLINE newArray_ #-}
 900     newArray_ (l,u) = newArray (l,u) arrEleBottom
 901
 902     -- newArray takes an initialiser which all elements of
 903     -- the newly created array are initialised to.  unsafeNewArray_ takes
 904     -- no initialiser, it is assumed that the array is initialised with
 905     -- "undefined" values.
 906
 907     -- why not omit unsafeNewArray_?  Because in the unboxed array
 908     -- case we would like to omit the initialisation altogether if
 909     -- possible.  We can't do this for boxed arrays, because the
 910     -- elements must all have valid values at all times in case of
 911     -- garbage collection.
 912
 913     -- why not omit newArray?  Because in the boxed case, we can omit the
 914     -- default initialisation with undefined values if we *do* know the
 915     -- initial value and it is constant for all elements.
 916
 917 {-# INLINE newListArray #-}
 918 -- | Constructs a mutable array from a list of initial elements.
 919 -- The list gives the elements of the array in ascending order
 920 -- beginning with the lowest index.
 921 newListArray :: (MArray a e m, Ix i) => (i,i) -> [e] -> m (a i e)
 922 newListArray (l,u) es = do
 923     marr <- newArray_ (l,u)
 924     let n = rangeSize (l,u)
 925     let fillFromList i xs | i == n    = return ()
 926                           | otherwise = case xs of
 927             []   -> return ()
 928             y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys
 929     fillFromList 0 es
 930     return marr
 931
 932 {-# INLINE readArray #-}
 933 -- | Read an element from a mutable array
 934 readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
 935 readArray marr i = do
 936   (l,u) <- getBounds marr
 937   unsafeRead marr (index (l,u) i)
 938
 939 {-# INLINE writeArray #-}
 940 -- | Write an element in a mutable array
 941 writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
 942 writeArray marr i e = do
 943   (l,u) <- getBounds marr
 944   unsafeWrite marr (index (l,u) i) e
 945
 946 {-# INLINE getElems #-}
 947 -- | Return a list of all the elements of a mutable array
 948 getElems :: (MArray a e m, Ix i) => a i e -> m [e]
 949 getElems marr = do
 950   (l,u) <- getBounds marr
 951   sequence [unsafeRead marr i | i <- [0 .. rangeSize (l,u) - 1]]
 952
 953 {-# INLINE getAssocs #-}
 954 -- | Return a list of all the associations of a mutable array, in
 955 -- index order.
 956 getAssocs :: (MArray a e m, Ix i) => a i e -> m [(i, e)]
 957 getAssocs marr = do
 958   (l,u) <- getBounds marr
 959   sequence [ do e <- unsafeRead marr (index (l,u) i); return (i,e)
 960            | i <- range (l,u)]
 961
 962 {-# INLINE mapArray #-}
 963 -- | Constructs a new array derived from the original array by applying a
 964 -- function to each of the elements.
 965 mapArray :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e)
 966 mapArray f marr = do
 967   (l,u) <- getBounds marr
 968   marr' <- newArray_ (l,u)
 969   sequence_ [do
 970         e <- unsafeRead marr i
 971         unsafeWrite marr' i (f e)
 972         | i <- [0 .. rangeSize (l,u) - 1]]
 973   return marr'
 974
 975 {-# INLINE mapIndices #-}
 976 -- | Constructs a new array derived from the original array by applying a
 977 -- function to each of the indices.
 978 mapIndices :: (MArray a e m, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> m (a i e)
 979 mapIndices (l,u) f marr = do
 980     marr' <- newArray_ (l,u)
 981     sequence_ [do
 982         e <- readArray marr (f i)
 983         unsafeWrite marr' (unsafeIndex (l,u) i) e
 984         | i <- range (l,u)]
 985     return marr'
 986
 987 -----------------------------------------------------------------------------
 988 -- Polymorphic non-strict mutable arrays (ST monad)
 989
 990 instance MArray (STArray s) e (ST s) where
 991     {-# INLINE getBounds #-}
 992     getBounds arr = return $! ArrST.boundsSTArray arr
 993     {-# INLINE newArray #-}
 994     newArray    = ArrST.newSTArray
 995     {-# INLINE unsafeRead #-}
 996     unsafeRead  = ArrST.unsafeReadSTArray
 997     {-# INLINE unsafeWrite #-}
 998     unsafeWrite = ArrST.unsafeWriteSTArray
 999
1000 instance MArray (STArray s) e (Lazy.ST s) where
1001     {-# INLINE getBounds #-}
1002     getBounds arr = strictToLazyST (return $! ArrST.boundsSTArray arr)
1003     {-# INLINE newArray #-}
1004     newArray (l,u) e    = strictToLazyST (ArrST.newSTArray (l,u) e)
1005     {-# INLINE unsafeRead #-}
1006     unsafeRead arr i    = strictToLazyST (ArrST.unsafeReadSTArray arr i)
1007     {-# INLINE unsafeWrite #-}
1008     unsafeWrite arr i e = strictToLazyST (ArrST.unsafeWriteSTArray arr i e)
1009
1010 #ifdef __HUGS__
1011 INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray")
1012 #endif
1013
1014 -----------------------------------------------------------------------------
1015 -- Flat unboxed mutable arrays (ST monad)
1016
1017 -- | A mutable array with unboxed elements, that can be manipulated in
1018 -- the 'ST' monad.  The type arguments are as follows:
1019 --
1020 --  * @s@: the state variable argument for the 'ST' type
1021 --
1022 --  * @i@: the index type of the array (should be an instance of @Ix@)
1023 --
1024 --  * @e@: the element type of the array.  Only certain element types
1025 --    are supported.
1026 --
1027 -- An 'STUArray' will generally be more efficient (in terms of both time
1028 -- and space) than the equivalent boxed version ('STArray') with the same
1029 -- element type.  However, 'STUArray' is strict in its elements - so
1030 -- don\'t use 'STUArray' if you require the non-strictness that
1031 -- 'STArray' provides.
1032 #ifdef __GLASGOW_HASKELL__
1033 data STUArray s i a = STUArray !i !i (MutableByteArray# s)
1034 #endif
1035 #ifdef __HUGS__
1036 data STUArray s i a = STUArray !i !i !(MutableByteArray s)
1037 #endif
1038
1039 INSTANCE_TYPEABLE3(STUArray,stUArrayTc,"STUArray")
1040
1041 #ifdef __GLASGOW_HASKELL__
1042 instance MArray (STUArray s) Bool (ST s) where
1043     {-# INLINE getBounds #-}
1044     getBounds (STUArray l u _) = return (l,u)
1045     {-# INLINE newArray #-}
1046     newArray (l,u) init = ST $ \s1# ->
1047         case rangeSize (l,u)            of { I# n# ->
1048         case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
1049         case bOOL_WORD_SCALE n#         of { n'# ->
1050         let loop i# s3# | i# ==# n'# = s3#
1051                         | otherwise  =
1052                 case writeWordArray# marr# i# e# s3# of { s4# ->
1053                 loop (i# +# 1#) s4# } in
1054         case loop 0# s2#                of { s3# ->
1055         (# s3#, STUArray l u marr# #) }}}}
1056       where
1057         W# e# = if init then maxBound else 0
1058     {-# INLINE unsafeNewArray_ #-}
1059     unsafeNewArray_ (l,u) = ST $ \s1# ->
1060         case rangeSize (l,u)            of { I# n# ->
1061         case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
1062         (# s2#, STUArray l u marr# #) }}
1063     {-# INLINE newArray_ #-}
1064     newArray_ bounds = newArray bounds False
1065     {-# INLINE unsafeRead #-}
1066     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1067         case readWordArray# marr# (bOOL_INDEX i#) s1# of { (# s2#, e# #) ->
1068         (# s2#, (e# `and#` bOOL_BIT i#) `neWord#` int2Word# 0# #) }
1069     {-# INLINE unsafeWrite #-}
1070     unsafeWrite (STUArray _ _ marr#) (I# i#) e = ST $ \s1# ->
1071         case bOOL_INDEX i#              of { j# ->
1072         case readWordArray# marr# j# s1# of { (# s2#, old# #) ->
1073         case if e then old# `or#` bOOL_BIT i#
1074              else old# `and#` bOOL_NOT_BIT i# of { e# ->
1075         case writeWordArray# marr# j# e# s2# of { s3# ->
1076         (# s3#, () #) }}}}
1077
1078 instance MArray (STUArray s) Char (ST s) where
1079     {-# INLINE getBounds #-}
1080     getBounds (STUArray l u _) = return (l,u)
1081     {-# INLINE unsafeNewArray_ #-}
1082     unsafeNewArray_ (l,u) = ST $ \s1# ->
1083         case rangeSize (l,u)            of { I# n# ->
1084         case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
1085         (# s2#, STUArray l u marr# #) }}
1086     {-# INLINE newArray_ #-}
1087     newArray_ bounds = newArray bounds (chr 0)
1088     {-# INLINE unsafeRead #-}
1089     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1090         case readWideCharArray# marr# i# s1# of { (# s2#, e# #) ->
1091         (# s2#, C# e# #) }
1092     {-# INLINE unsafeWrite #-}
1093     unsafeWrite (STUArray _ _ marr#) (I# i#) (C# e#) = ST $ \s1# ->
1094         case writeWideCharArray# marr# i# e# s1# of { s2# ->
1095         (# s2#, () #) }
1096
1097 instance MArray (STUArray s) Int (ST s) where
1098     {-# INLINE getBounds #-}
1099     getBounds (STUArray l u _) = return (l,u)
1100     {-# INLINE unsafeNewArray_ #-}
1101     unsafeNewArray_ (l,u) = ST $ \s1# ->
1102         case rangeSize (l,u)            of { I# n# ->
1103         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1104         (# s2#, STUArray l u marr# #) }}
1105     {-# INLINE newArray_ #-}
1106     newArray_ bounds = newArray bounds 0
1107     {-# INLINE unsafeRead #-}
1108     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1109         case readIntArray# marr# i# s1# of { (# s2#, e# #) ->
1110         (# s2#, I# e# #) }
1111     {-# INLINE unsafeWrite #-}
1112     unsafeWrite (STUArray _ _ marr#) (I# i#) (I# e#) = ST $ \s1# ->
1113         case writeIntArray# marr# i# e# s1# of { s2# ->
1114         (# s2#, () #) }
1115
1116 instance MArray (STUArray s) Word (ST s) where
1117     {-# INLINE getBounds #-}
1118     getBounds (STUArray l u _) = return (l,u)
1119     {-# INLINE unsafeNewArray_ #-}
1120     unsafeNewArray_ (l,u) = ST $ \s1# ->
1121         case rangeSize (l,u)            of { I# n# ->
1122         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1123         (# s2#, STUArray l u marr# #) }}
1124     {-# INLINE newArray_ #-}
1125     newArray_ bounds = newArray bounds 0
1126     {-# INLINE unsafeRead #-}
1127     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1128         case readWordArray# marr# i# s1# of { (# s2#, e# #) ->
1129         (# s2#, W# e# #) }
1130     {-# INLINE unsafeWrite #-}
1131     unsafeWrite (STUArray _ _ marr#) (I# i#) (W# e#) = ST $ \s1# ->
1132         case writeWordArray# marr# i# e# s1# of { s2# ->
1133         (# s2#, () #) }
1134
1135 instance MArray (STUArray s) (Ptr a) (ST s) where
1136     {-# INLINE getBounds #-}
1137     getBounds (STUArray l u _) = return (l,u)
1138     {-# INLINE unsafeNewArray_ #-}
1139     unsafeNewArray_ (l,u) = ST $ \s1# ->
1140         case rangeSize (l,u)            of { I# n# ->
1141         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1142         (# s2#, STUArray l u marr# #) }}
1143     {-# INLINE newArray_ #-}
1144     newArray_ bounds = newArray bounds nullPtr
1145     {-# INLINE unsafeRead #-}
1146     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1147         case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
1148         (# s2#, Ptr e# #) }
1149     {-# INLINE unsafeWrite #-}
1150     unsafeWrite (STUArray _ _ marr#) (I# i#) (Ptr e#) = ST $ \s1# ->
1151         case writeAddrArray# marr# i# e# s1# of { s2# ->
1152         (# s2#, () #) }
1153
1154 instance MArray (STUArray s) (FunPtr a) (ST s) where
1155     {-# INLINE getBounds #-}
1156     getBounds (STUArray l u _) = return (l,u)
1157     {-# INLINE unsafeNewArray_ #-}
1158     unsafeNewArray_ (l,u) = ST $ \s1# ->
1159         case rangeSize (l,u)            of { I# n# ->
1160         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1161         (# s2#, STUArray l u marr# #) }}
1162     {-# INLINE newArray_ #-}
1163     newArray_ bounds = newArray bounds nullFunPtr
1164     {-# INLINE unsafeRead #-}
1165     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1166         case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
1167         (# s2#, FunPtr e# #) }
1168     {-# INLINE unsafeWrite #-}
1169     unsafeWrite (STUArray _ _ marr#) (I# i#) (FunPtr e#) = ST $ \s1# ->
1170         case writeAddrArray# marr# i# e# s1# of { s2# ->
1171         (# s2#, () #) }
1172
1173 instance MArray (STUArray s) Float (ST s) where
1174     {-# INLINE getBounds #-}
1175     getBounds (STUArray l u _) = return (l,u)
1176     {-# INLINE unsafeNewArray_ #-}
1177     unsafeNewArray_ (l,u) = ST $ \s1# ->
1178         case rangeSize (l,u)            of { I# n# ->
1179         case newByteArray# (fLOAT_SCALE n#) s1# of { (# s2#, marr# #) ->
1180         (# s2#, STUArray l u marr# #) }}
1181     {-# INLINE newArray_ #-}
1182     newArray_ bounds = newArray bounds 0
1183     {-# INLINE unsafeRead #-}
1184     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1185         case readFloatArray# marr# i# s1# of { (# s2#, e# #) ->
1186         (# s2#, F# e# #) }
1187     {-# INLINE unsafeWrite #-}
1188     unsafeWrite (STUArray _ _ marr#) (I# i#) (F# e#) = ST $ \s1# ->
1189         case writeFloatArray# marr# i# e# s1# of { s2# ->
1190         (# s2#, () #) }
1191
1192 instance MArray (STUArray s) Double (ST s) where
1193     {-# INLINE getBounds #-}
1194     getBounds (STUArray l u _) = return (l,u)
1195     {-# INLINE unsafeNewArray_ #-}
1196     unsafeNewArray_ (l,u) = ST $ \s1# ->
1197         case rangeSize (l,u)            of { I# n# ->
1198         case newByteArray# (dOUBLE_SCALE n#) s1# of { (# s2#, marr# #) ->
1199         (# s2#, STUArray l u marr# #) }}
1200     {-# INLINE newArray_ #-}
1201     newArray_ bounds = newArray bounds 0
1202     {-# INLINE unsafeRead #-}
1203     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1204         case readDoubleArray# marr# i# s1# of { (# s2#, e# #) ->
1205         (# s2#, D# e# #) }
1206     {-# INLINE unsafeWrite #-}
1207     unsafeWrite (STUArray _ _ marr#) (I# i#) (D# e#) = ST $ \s1# ->
1208         case writeDoubleArray# marr# i# e# s1# of { s2# ->
1209         (# s2#, () #) }
1210
1211 instance MArray (STUArray s) (StablePtr a) (ST s) where
1212     {-# INLINE getBounds #-}
1213     getBounds (STUArray l u _) = return (l,u)
1214     {-# INLINE unsafeNewArray_ #-}
1215     unsafeNewArray_ (l,u) = ST $ \s1# ->
1216         case rangeSize (l,u)            of { I# n# ->
1217         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1218         (# s2#, STUArray l u marr# #) }}
1219     {-# INLINE newArray_ #-}
1220     newArray_ bounds = newArray bounds (castPtrToStablePtr nullPtr)
1221     {-# INLINE unsafeRead #-}
1222     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1223         case readStablePtrArray# marr# i# s1# of { (# s2#, e# #) ->
1224         (# s2# , StablePtr e# #) }
1225     {-# INLINE unsafeWrite #-}
1226     unsafeWrite (STUArray _ _ marr#) (I# i#) (StablePtr e#) = ST $ \s1# ->
1227         case writeStablePtrArray# marr# i# e# s1# of { s2# ->
1228         (# s2#, () #) }
1229
1230 instance MArray (STUArray s) Int8 (ST s) where
1231     {-# INLINE getBounds #-}
1232     getBounds (STUArray l u _) = return (l,u)
1233     {-# INLINE unsafeNewArray_ #-}
1234     unsafeNewArray_ (l,u) = ST $ \s1# ->
1235         case rangeSize (l,u)            of { I# n# ->
1236         case newByteArray# n# s1#       of { (# s2#, marr# #) ->
1237         (# s2#, STUArray l u marr# #) }}
1238     {-# INLINE newArray_ #-}
1239     newArray_ bounds = newArray bounds 0
1240     {-# INLINE unsafeRead #-}
1241     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1242         case readInt8Array# marr# i# s1# of { (# s2#, e# #) ->
1243         (# s2#, I8# e# #) }
1244     {-# INLINE unsafeWrite #-}
1245     unsafeWrite (STUArray _ _ marr#) (I# i#) (I8# e#) = ST $ \s1# ->
1246         case writeInt8Array# marr# i# e# s1# of { s2# ->
1247         (# s2#, () #) }
1248
1249 instance MArray (STUArray s) Int16 (ST s) where
1250     {-# INLINE getBounds #-}
1251     getBounds (STUArray l u _) = return (l,u)
1252     {-# INLINE unsafeNewArray_ #-}
1253     unsafeNewArray_ (l,u) = ST $ \s1# ->
1254         case rangeSize (l,u)            of { I# n# ->
1255         case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) ->
1256         (# s2#, STUArray l u marr# #) }}
1257     {-# INLINE newArray_ #-}
1258     newArray_ bounds = newArray bounds 0
1259     {-# INLINE unsafeRead #-}
1260     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1261         case readInt16Array# marr# i# s1# of { (# s2#, e# #) ->
1262         (# s2#, I16# e# #) }
1263     {-# INLINE unsafeWrite #-}
1264     unsafeWrite (STUArray _ _ marr#) (I# i#) (I16# e#) = ST $ \s1# ->
1265         case writeInt16Array# marr# i# e# s1# of { s2# ->
1266         (# s2#, () #) }
1267
1268 instance MArray (STUArray s) Int32 (ST s) where
1269     {-# INLINE getBounds #-}
1270     getBounds (STUArray l u _) = return (l,u)
1271     {-# INLINE unsafeNewArray_ #-}
1272     unsafeNewArray_ (l,u) = ST $ \s1# ->
1273         case rangeSize (l,u)            of { I# n# ->
1274         case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
1275         (# s2#, STUArray l u marr# #) }}
1276     {-# INLINE newArray_ #-}
1277     newArray_ bounds = newArray bounds 0
1278     {-# INLINE unsafeRead #-}
1279     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1280         case readInt32Array# marr# i# s1# of { (# s2#, e# #) ->
1281         (# s2#, I32# e# #) }
1282     {-# INLINE unsafeWrite #-}
1283     unsafeWrite (STUArray _ _ marr#) (I# i#) (I32# e#) = ST $ \s1# ->
1284         case writeInt32Array# marr# i# e# s1# of { s2# ->
1285         (# s2#, () #) }
1286
1287 instance MArray (STUArray s) Int64 (ST s) where
1288     {-# INLINE getBounds #-}
1289     getBounds (STUArray l u _) = return (l,u)
1290     {-# INLINE unsafeNewArray_ #-}
1291     unsafeNewArray_ (l,u) = ST $ \s1# ->
1292         case rangeSize (l,u)            of { I# n# ->
1293         case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) ->
1294         (# s2#, STUArray l u marr# #) }}
1295     {-# INLINE newArray_ #-}
1296     newArray_ bounds = newArray bounds 0
1297     {-# INLINE unsafeRead #-}
1298     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1299         case readInt64Array# marr# i# s1# of { (# s2#, e# #) ->
1300         (# s2#, I64# e# #) }
1301     {-# INLINE unsafeWrite #-}
1302     unsafeWrite (STUArray _ _ marr#) (I# i#) (I64# e#) = ST $ \s1# ->
1303         case writeInt64Array# marr# i# e# s1# of { s2# ->
1304         (# s2#, () #) }
1305
1306 instance MArray (STUArray s) Word8 (ST s) where
1307     {-# INLINE getBounds #-}
1308     getBounds (STUArray l u _) = return (l,u)
1309     {-# INLINE unsafeNewArray_ #-}
1310     unsafeNewArray_ (l,u) = ST $ \s1# ->
1311         case rangeSize (l,u)            of { I# n# ->
1312         case newByteArray# n# s1#       of { (# s2#, marr# #) ->
1313         (# s2#, STUArray l u marr# #) }}
1314     {-# INLINE newArray_ #-}
1315     newArray_ bounds = newArray bounds 0
1316     {-# INLINE unsafeRead #-}
1317     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1318         case readWord8Array# marr# i# s1# of { (# s2#, e# #) ->
1319         (# s2#, W8# e# #) }
1320     {-# INLINE unsafeWrite #-}
1321     unsafeWrite (STUArray _ _ marr#) (I# i#) (W8# e#) = ST $ \s1# ->
1322         case writeWord8Array# marr# i# e# s1# of { s2# ->
1323         (# s2#, () #) }
1324
1325 instance MArray (STUArray s) Word16 (ST s) where
1326     {-# INLINE getBounds #-}
1327     getBounds (STUArray l u _) = return (l,u)
1328     {-# INLINE unsafeNewArray_ #-}
1329     unsafeNewArray_ (l,u) = ST $ \s1# ->
1330         case rangeSize (l,u)            of { I# n# ->
1331         case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) ->
1332         (# s2#, STUArray l u marr# #) }}
1333     {-# INLINE newArray_ #-}
1334     newArray_ bounds = newArray bounds 0
1335     {-# INLINE unsafeRead #-}
1336     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1337         case readWord16Array# marr# i# s1# of { (# s2#, e# #) ->
1338         (# s2#, W16# e# #) }
1339     {-# INLINE unsafeWrite #-}
1340     unsafeWrite (STUArray _ _ marr#) (I# i#) (W16# e#) = ST $ \s1# ->
1341         case writeWord16Array# marr# i# e# s1# of { s2# ->
1342         (# s2#, () #) }
1343
1344 instance MArray (STUArray s) Word32 (ST s) where
1345     {-# INLINE getBounds #-}
1346     getBounds (STUArray l u _) = return (l,u)
1347     {-# INLINE unsafeNewArray_ #-}
1348     unsafeNewArray_ (l,u) = ST $ \s1# ->
1349         case rangeSize (l,u)            of { I# n# ->
1350         case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
1351         (# s2#, STUArray l u marr# #) }}
1352     {-# INLINE newArray_ #-}
1353     newArray_ bounds = newArray bounds 0
1354     {-# INLINE unsafeRead #-}
1355     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1356         case readWord32Array# marr# i# s1# of { (# s2#, e# #) ->
1357         (# s2#, W32# e# #) }
1358     {-# INLINE unsafeWrite #-}
1359     unsafeWrite (STUArray _ _ marr#) (I# i#) (W32# e#) = ST $ \s1# ->
1360         case writeWord32Array# marr# i# e# s1# of { s2# ->
1361         (# s2#, () #) }
1362
1363 instance MArray (STUArray s) Word64 (ST s) where
1364     {-# INLINE getBounds #-}
1365     getBounds (STUArray l u _) = return (l,u)
1366     {-# INLINE unsafeNewArray_ #-}
1367     unsafeNewArray_ (l,u) = ST $ \s1# ->
1368         case rangeSize (l,u)            of { I# n# ->
1369         case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) ->
1370         (# s2#, STUArray l u marr# #) }}
1371     {-# INLINE newArray_ #-}
1372     newArray_ bounds = newArray bounds 0
1373     {-# INLINE unsafeRead #-}
1374     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1375         case readWord64Array# marr# i# s1# of { (# s2#, e# #) ->
1376         (# s2#, W64# e# #) }
1377     {-# INLINE unsafeWrite #-}
1378     unsafeWrite (STUArray _ _ marr#) (I# i#) (W64# e#) = ST $ \s1# ->
1379         case writeWord64Array# marr# i# e# s1# of { s2# ->
1380         (# s2#, () #) }
1381
1382 -----------------------------------------------------------------------------
1383 -- Translation between elements and bytes
1384
1385 bOOL_SCALE, bOOL_WORD_SCALE,
1386   wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int#
1387 bOOL_SCALE n# = (n# +# last#) `uncheckedIShiftRA#` 3#
1388   where I# last# = SIZEOF_HSWORD * 8 - 1
1389 bOOL_WORD_SCALE n# = bOOL_INDEX (n# +# last#)
1390   where I# last# = SIZEOF_HSWORD * 8 - 1
1391 wORD_SCALE   n# = scale# *# n# where I# scale# = SIZEOF_HSWORD
1392 dOUBLE_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSDOUBLE
1393 fLOAT_SCALE  n# = scale# *# n# where I# scale# = SIZEOF_HSFLOAT
1394
1395 bOOL_INDEX :: Int# -> Int#
1396 #if SIZEOF_HSWORD == 4
1397 bOOL_INDEX i# = i# `uncheckedIShiftRA#` 5#
1398 #elif SIZEOF_HSWORD == 8
1399 bOOL_INDEX i# = i# `uncheckedIShiftRA#` 6#
1400 #endif
1401
1402 bOOL_BIT, bOOL_NOT_BIT :: Int# -> Word#
1403 bOOL_BIT     n# = int2Word# 1# `uncheckedShiftL#` (word2Int# (int2Word# n# `and#` mask#))
1404   where W# mask# = SIZEOF_HSWORD * 8 - 1
1405 bOOL_NOT_BIT n# = bOOL_BIT n# `xor#` mb# where W# mb# = maxBound
1406 #endif /* __GLASGOW_HASKELL__ */
1407
1408 #ifdef __HUGS__
1409 newMBArray_ :: (Ix i, Storable e) => (i,i) -> ST s (STUArray s i e)
1410 newMBArray_ = makeArray undefined
1411   where
1412     makeArray :: (Ix i, Storable e) => e -> (i,i) -> ST s (STUArray s i e)
1413     makeArray dummy (l,u) = do
1414         marr <- newMutableByteArray (rangeSize (l,u) * sizeOf dummy)
1415         return (STUArray l u marr)
1416
1417 unsafeReadMBArray :: Storable e => STUArray s i e -> Int -> ST s e
1418 unsafeReadMBArray (STUArray _ _ marr) = readMutableByteArray marr
1419
1420 unsafeWriteMBArray :: Storable e => STUArray s i e -> Int -> e -> ST s ()
1421 unsafeWriteMBArray (STUArray _ _ marr) = writeMutableByteArray marr
1422
1423 getBoundsMBArray (STUArray l u _) = return (l,u)
1424
1425 instance MArray (STUArray s) Bool (ST s) where
1426     getBounds = getBoundsMBArray
1427     unsafeNewArray_ (l,u) = do
1428         marr <- newMutableByteArray (bOOL_SCALE (rangeSize (l,u)))
1429         return (STUArray l u marr)
1430     newArray_ bounds = unsafeNewArray_ bounds
1431     unsafeRead (STUArray _ _ marr) i = do
1432         let ix = bOOL_INDEX i
1433             bit = bOOL_SUBINDEX i
1434         w <- readMutableByteArray marr ix
1435         return (testBit (w::BitSet) bit)
1436     unsafeWrite (STUArray _ _ marr) i e = do
1437         let ix = bOOL_INDEX i
1438             bit = bOOL_SUBINDEX i
1439         w <- readMutableByteArray marr ix
1440         writeMutableByteArray marr ix
1441             (if e then setBit (w::BitSet) bit else clearBit w bit)
1442
1443 instance MArray (STUArray s) Char (ST s) where
1444     getBounds = getBoundsMBArray
1445     unsafeNewArray_ = newMBArray_
1446     newArray_  = unsafeNewArray_
1447     unsafeRead = unsafeReadMBArray
1448     unsafeWrite = unsafeWriteMBArray
1449
1450 instance MArray (STUArray s) Int (ST s) where
1451     getBounds = getBoundsMBArray
1452     unsafeNewArray_ = newMBArray_
1453     newArray_  = unsafeNewArray_
1454     unsafeRead = unsafeReadMBArray
1455     unsafeWrite = unsafeWriteMBArray
1456
1457 instance MArray (STUArray s) Word (ST s) where
1458     getBounds = getBoundsMBArray
1459     unsafeNewArray_ = newMBArray_
1460     newArray_  = unsafeNewArray_
1461     unsafeRead = unsafeReadMBArray
1462     unsafeWrite = unsafeWriteMBArray
1463
1464 instance MArray (STUArray s) (Ptr a) (ST s) where
1465     getBounds = getBoundsMBArray
1466     unsafeNewArray_ = newMBArray_
1467     newArray_  = unsafeNewArray_
1468     unsafeRead = unsafeReadMBArray
1469     unsafeWrite = unsafeWriteMBArray
1470
1471 instance MArray (STUArray s) (FunPtr a) (ST s) where
1472     getBounds = getBoundsMBArray
1473     unsafeNewArray_ = newMBArray_
1474     newArray_  = unsafeNewArray_
1475     unsafeRead = unsafeReadMBArray
1476     unsafeWrite = unsafeWriteMBArray
1477
1478 instance MArray (STUArray s) Float (ST s) where
1479     getBounds = getBoundsMBArray
1480     unsafeNewArray_ = newMBArray_
1481     newArray_  = unsafeNewArray_
1482     unsafeRead = unsafeReadMBArray
1483     unsafeWrite = unsafeWriteMBArray
1484
1485 instance MArray (STUArray s) Double (ST s) where
1486     getBounds = getBoundsMBArray
1487     unsafeNewArray_ = newMBArray_
1488     newArray_  = unsafeNewArray_
1489     unsafeRead = unsafeReadMBArray
1490     unsafeWrite = unsafeWriteMBArray
1491
1492 instance MArray (STUArray s) (StablePtr a) (ST s) where
1493     getBounds = getBoundsMBArray
1494     unsafeNewArray_ = newMBArray_
1495     newArray_  = unsafeNewArray_
1496     unsafeRead = unsafeReadMBArray
1497     unsafeWrite = unsafeWriteMBArray
1498
1499 instance MArray (STUArray s) Int8 (ST s) where
1500     getBounds = getBoundsMBArray
1501     unsafeNewArray_ = newMBArray_
1502     newArray_  = unsafeNewArray_
1503     unsafeRead = unsafeReadMBArray
1504     unsafeWrite = unsafeWriteMBArray
1505
1506 instance MArray (STUArray s) Int16 (ST s) where
1507     getBounds = getBoundsMBArray
1508     unsafeNewArray_ = newMBArray_
1509     newArray_  = unsafeNewArray_
1510     unsafeRead = unsafeReadMBArray
1511     unsafeWrite = unsafeWriteMBArray
1512
1513 instance MArray (STUArray s) Int32 (ST s) where
1514     getBounds = getBoundsMBArray
1515     unsafeNewArray_ = newMBArray_
1516     newArray_  = unsafeNewArray_
1517     unsafeRead = unsafeReadMBArray
1518     unsafeWrite = unsafeWriteMBArray
1519
1520 instance MArray (STUArray s) Int64 (ST s) where
1521     getBounds = getBoundsMBArray
1522     unsafeNewArray_ = newMBArray_
1523     newArray_  = unsafeNewArray_
1524     unsafeRead = unsafeReadMBArray
1525     unsafeWrite = unsafeWriteMBArray
1526
1527 instance MArray (STUArray s) Word8 (ST s) where
1528     getBounds = getBoundsMBArray
1529     unsafeNewArray_ = newMBArray_
1530     newArray_  = unsafeNewArray_
1531     unsafeRead = unsafeReadMBArray
1532     unsafeWrite = unsafeWriteMBArray
1533
1534 instance MArray (STUArray s) Word16 (ST s) where
1535     getBounds = getBoundsMBArray
1536     unsafeNewArray_ = newMBArray_
1537     newArray_  = unsafeNewArray_
1538     unsafeRead = unsafeReadMBArray
1539     unsafeWrite = unsafeWriteMBArray
1540
1541 instance MArray (STUArray s) Word32 (ST s) where
1542     getBounds = getBoundsMBArray
1543     unsafeNewArray_ = newMBArray_
1544     newArray_  = unsafeNewArray_
1545     unsafeRead = unsafeReadMBArray
1546     unsafeWrite = unsafeWriteMBArray
1547
1548 instance MArray (STUArray s) Word64 (ST s) where
1549     getBounds = getBoundsMBArray
1550     unsafeNewArray_ = newMBArray_
1551     newArray_  = unsafeNewArray_
1552     unsafeRead = unsafeReadMBArray
1553     unsafeWrite = unsafeWriteMBArray
1554
1555 type BitSet = Word8
1556
1557 bitSetSize = bitSize (0::BitSet)
1558
1559 bOOL_SCALE :: Int -> Int
1560 bOOL_SCALE n = (n + bitSetSize - 1) `div` bitSetSize
1561
1562 bOOL_INDEX :: Int -> Int
1563 bOOL_INDEX i = i `div` bitSetSize
1564
1565 bOOL_SUBINDEX :: Int -> Int
1566 bOOL_SUBINDEX i = i `mod` bitSetSize
1567 #endif /* __HUGS__ */
1568
1569 -----------------------------------------------------------------------------
1570 -- Freezing
1571
1572 -- | Converts a mutable array (any instance of 'MArray') to an
1573 -- immutable array (any instance of 'IArray') by taking a complete
1574 -- copy of it.
1575 freeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
1576 freeze marr = do
1577   (l,u) <- getBounds marr
1578   ies <- sequence [do e <- unsafeRead marr i; return (i,e)
1579                    | i <- [0 .. rangeSize (l,u) - 1]]
1580   return (unsafeArray (l,u) ies)
1581
1582 #ifdef __GLASGOW_HASKELL__
1583 freezeSTUArray :: Ix i => STUArray s i e -> ST s (UArray i e)
1584 freezeSTUArray (STUArray l u marr#) = ST $ \s1# ->
1585     case sizeofMutableByteArray# marr#  of { n# ->
1586     case newByteArray# n# s1#           of { (# s2#, marr'# #) ->
1587     case memcpy_freeze marr'# marr# (fromIntegral (I# n#)) of { IO m ->
1588     case unsafeCoerce# m s2#            of { (# s3#, _ #) ->
1589     case unsafeFreezeByteArray# marr'# s3# of { (# s4#, arr# #) ->
1590     (# s4#, UArray l u arr# #) }}}}}
1591
1592 foreign import ccall unsafe "memcpy"
1593     memcpy_freeze :: MutableByteArray# s -> MutableByteArray# s -> CSize
1594            -> IO (Ptr a)
1595
1596 {-# RULES
1597 "freeze/STArray"  freeze = ArrST.freezeSTArray
1598 "freeze/STUArray" freeze = freezeSTUArray
1599     #-}
1600 #endif /* __GLASGOW_HASKELL__ */
1601
1602 -- In-place conversion of mutable arrays to immutable ones places
1603 -- a proof obligation on the user: no other parts of your code can
1604 -- have a reference to the array at the point where you unsafely
1605 -- freeze it (and, subsequently mutate it, I suspect).
1606
1607 {- |
1608    Converts an mutable array into an immutable array.  The
1609    implementation may either simply cast the array from
1610    one type to the other without copying the array, or it
1611    may take a full copy of the array.
1612
1613    Note that because the array is possibly not copied, any subsequent
1614    modifications made to the mutable version of the array may be
1615    shared with the immutable version.  It is safe to use, therefore, if
1616    the mutable version is never modified after the freeze operation.
1617
1618    The non-copying implementation is supported between certain pairs
1619    of array types only; one constraint is that the array types must
1620    have identical representations.  In GHC, The following pairs of
1621    array types have a non-copying O(1) implementation of
1622    'unsafeFreeze'.  Because the optimised versions are enabled by
1623    specialisations, you will need to compile with optimisation (-O) to
1624    get them.
1625
1626      * 'Data.Array.IO.IOUArray' -> 'Data.Array.Unboxed.UArray'
1627
1628      * 'Data.Array.ST.STUArray' -> 'Data.Array.Unboxed.UArray'
1629
1630      * 'Data.Array.IO.IOArray' -> 'Data.Array.Array'
1631
1632      * 'Data.Array.ST.STArray' -> 'Data.Array.Array'
1633 -}
1634 {-# INLINE unsafeFreeze #-}
1635 unsafeFreeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
1636 unsafeFreeze = freeze
1637
1638 {-# RULES
1639 "unsafeFreeze/STArray"  unsafeFreeze = ArrST.unsafeFreezeSTArray
1640 "unsafeFreeze/STUArray" unsafeFreeze = unsafeFreezeSTUArray
1641     #-}
1642
1643 -----------------------------------------------------------------------------
1644 -- Thawing
1645
1646 -- | Converts an immutable array (any instance of 'IArray') into a
1647 -- mutable array (any instance of 'MArray') by taking a complete copy
1648 -- of it.
1649 thaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
1650 thaw arr = case bounds arr of
1651   (l,u) -> do
1652     marr <- newArray_ (l,u)
1653     sequence_ [unsafeWrite marr i (unsafeAt arr i)
1654                | i <- [0 .. rangeSize (l,u) - 1]]
1655     return marr
1656
1657 #ifdef __GLASGOW_HASKELL__
1658 thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1659 thawSTUArray (UArray l u arr#) = ST $ \s1# ->
1660     case sizeofByteArray# arr#          of { n# ->
1661     case newByteArray# n# s1#           of { (# s2#, marr# #) ->
1662     case memcpy_thaw marr# arr# (fromIntegral (I# n#)) of { IO m ->
1663     case unsafeCoerce# m s2#            of { (# s3#, _ #) ->
1664     (# s3#, STUArray l u marr# #) }}}}
1665
1666 foreign import ccall unsafe "memcpy"
1667     memcpy_thaw :: MutableByteArray# s -> ByteArray# -> CSize
1668            -> IO (Ptr a)
1669
1670 {-# RULES
1671 "thaw/STArray"  thaw = ArrST.thawSTArray
1672 "thaw/STUArray" thaw = thawSTUArray
1673     #-}
1674 #endif /* __GLASGOW_HASKELL__ */
1675
1676 #ifdef __HUGS__
1677 thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1678 thawSTUArray (UArray l u arr) = do
1679     marr <- thawByteArray arr
1680     return (STUArray l u marr)
1681 #endif
1682
1683 -- In-place conversion of immutable arrays to mutable ones places
1684 -- a proof obligation on the user: no other parts of your code can
1685 -- have a reference to the array at the point where you unsafely
1686 -- thaw it (and, subsequently mutate it, I suspect).
1687
1688 {- |
1689    Converts an immutable array into a mutable array.  The
1690    implementation may either simply cast the array from
1691    one type to the other without copying the array, or it
1692    may take a full copy of the array.
1693
1694    Note that because the array is possibly not copied, any subsequent
1695    modifications made to the mutable version of the array may be
1696    shared with the immutable version.  It is only safe to use,
1697    therefore, if the immutable array is never referenced again in this
1698    thread, and there is no possibility that it can be also referenced
1699    in another thread.  If you use an unsafeThaw/write/unsafeFreeze
1700    sequence in a multi-threaded setting, then you must ensure that
1701    this sequence is atomic with respect to other threads, or a garbage
1702    collector crash may result (because the write may be writing to a
1703    frozen array).
1704
1705    The non-copying implementation is supported between certain pairs
1706    of array types only; one constraint is that the array types must
1707    have identical representations.  In GHC, The following pairs of
1708    array types have a non-copying O(1) implementation of
1709    'unsafeThaw'.  Because the optimised versions are enabled by
1710    specialisations, you will need to compile with optimisation (-O) to
1711    get them.
1712
1713      * 'Data.Array.Unboxed.UArray' -> 'Data.Array.IO.IOUArray'
1714
1715      * 'Data.Array.Unboxed.UArray' -> 'Data.Array.ST.STUArray'
1716
1717      * 'Data.Array.Array'  -> 'Data.Array.IO.IOArray'
1718
1719      * 'Data.Array.Array'  -> 'Data.Array.ST.STArray'
1720 -}
1721 {-# INLINE unsafeThaw #-}
1722 unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
1723 unsafeThaw = thaw
1724
1725 #ifdef __GLASGOW_HASKELL__
1726 {-# INLINE unsafeThawSTUArray #-}
1727 unsafeThawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1728 unsafeThawSTUArray (UArray l u marr#) =
1729     return (STUArray l u (unsafeCoerce# marr#))
1730
1731 {-# RULES
1732 "unsafeThaw/STArray"    unsafeThaw = ArrST.unsafeThawSTArray
1733 "unsafeThaw/STUArray"   unsafeThaw = unsafeThawSTUArray
1734     #-}
1735 #endif /* __GLASGOW_HASKELL__ */
1736
1737 -- | Casts an 'STUArray' with one element type into one with a
1738 -- different element type.  All the elements of the resulting array
1739 -- are undefined (unless you know what you\'re doing...).
1740
1741 #ifdef __GLASGOW_HASKELL__
1742 castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
1743 castSTUArray (STUArray l u marr#) = return (STUArray l u marr#)
1744 #endif
1745
1746 #ifdef __HUGS__
1747 castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
1748 castSTUArray (STUArray l u marr) = return (STUArray l u marr)
1749 #endif