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 undefined.
 875     newArray_   :: Ix i => (i,i) -> m (a i e)
 876
 877     unsafeRead  :: Ix i => a i e -> Int -> m e
 878     unsafeWrite :: Ix i => a i e -> Int -> e -> m ()
 879
 880     {-# INLINE newArray #-}
 881         -- The INLINE is crucial, because until we know at least which monad
 882         -- we are in, the code below allocates like crazy.  So inline it,
 883         -- in the hope that the context will know the monad.
 884     newArray (l,u) init = do
 885         marr <- newArray_ (l,u)
 886         sequence_ [unsafeWrite marr i init | i <- [0 .. rangeSize (l,u) - 1]]
 887         return marr
 888
 889     newArray_ (l,u) = newArray (l,u) arrEleBottom
 890
 891     -- newArray takes an initialiser which all elements of
 892     -- the newly created array are initialised to.  newArray_ takes
 893     -- no initialiser, it is assumed that the array is initialised with
 894     -- "undefined" values.
 895
 896     -- why not omit newArray_?  Because in the unboxed array case we would
 897     -- like to omit the initialisation altogether if possible.  We can't do
 898     -- this for boxed arrays, because the elements must all have valid values
 899     -- at all times in case of garbage collection.
 900
 901     -- why not omit newArray?  Because in the boxed case, we can omit the
 902     -- default initialisation with undefined values if we *do* know the
 903     -- initial value and it is constant for all elements.
 904
 905 {-# INLINE newListArray #-}
 906 -- | Constructs a mutable array from a list of initial elements.
 907 -- The list gives the elements of the array in ascending order
 908 -- beginning with the lowest index.
 909 newListArray :: (MArray a e m, Ix i) => (i,i) -> [e] -> m (a i e)
 910 newListArray (l,u) es = do
 911     marr <- newArray_ (l,u)
 912     let n = rangeSize (l,u)
 913     let fillFromList i xs | i == n    = return ()
 914                           | otherwise = case xs of
 915             []   -> return ()
 916             y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys
 917     fillFromList 0 es
 918     return marr
 919
 920 {-# INLINE readArray #-}
 921 -- | Read an element from a mutable array
 922 readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
 923 readArray marr i = do
 924   (l,u) <- getBounds marr
 925   unsafeRead marr (index (l,u) i)
 926
 927 {-# INLINE writeArray #-}
 928 -- | Write an element in a mutable array
 929 writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
 930 writeArray marr i e = do
 931   (l,u) <- getBounds marr
 932   unsafeWrite marr (index (l,u) i) e
 933
 934 {-# INLINE getElems #-}
 935 -- | Return a list of all the elements of a mutable array
 936 getElems :: (MArray a e m, Ix i) => a i e -> m [e]
 937 getElems marr = do
 938   (l,u) <- getBounds marr
 939   sequence [unsafeRead marr i | i <- [0 .. rangeSize (l,u) - 1]]
 940
 941 {-# INLINE getAssocs #-}
 942 -- | Return a list of all the associations of a mutable array, in
 943 -- index order.
 944 getAssocs :: (MArray a e m, Ix i) => a i e -> m [(i, e)]
 945 getAssocs marr = do
 946   (l,u) <- getBounds marr
 947   sequence [ do e <- unsafeRead marr (index (l,u) i); return (i,e)
 948            | i <- range (l,u)]
 949
 950 {-# INLINE mapArray #-}
 951 -- | Constructs a new array derived from the original array by applying a
 952 -- function to each of the elements.
 953 mapArray :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e)
 954 mapArray f marr = do
 955   (l,u) <- getBounds marr
 956   marr' <- newArray_ (l,u)
 957   sequence_ [do
 958         e <- unsafeRead marr i
 959         unsafeWrite marr' i (f e)
 960         | i <- [0 .. rangeSize (l,u) - 1]]
 961   return marr'
 962
 963 {-# INLINE mapIndices #-}
 964 -- | Constructs a new array derived from the original array by applying a
 965 -- function to each of the indices.
 966 mapIndices :: (MArray a e m, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> m (a i e)
 967 mapIndices (l,u) f marr = do
 968     marr' <- newArray_ (l,u)
 969     sequence_ [do
 970         e <- readArray marr (f i)
 971         unsafeWrite marr' (unsafeIndex (l,u) i) e
 972         | i <- range (l,u)]
 973     return marr'
 974
 975 -----------------------------------------------------------------------------
 976 -- Polymorphic non-strict mutable arrays (ST monad)
 977
 978 instance MArray (STArray s) e (ST s) where
 979     {-# INLINE getBounds #-}
 980     getBounds arr = return $! ArrST.boundsSTArray arr
 981     {-# INLINE newArray #-}
 982     newArray    = ArrST.newSTArray
 983     {-# INLINE unsafeRead #-}
 984     unsafeRead  = ArrST.unsafeReadSTArray
 985     {-# INLINE unsafeWrite #-}
 986     unsafeWrite = ArrST.unsafeWriteSTArray
 987
 988 instance MArray (STArray s) e (Lazy.ST s) where
 989     {-# INLINE getBounds #-}
 990     getBounds arr = strictToLazyST (return $! ArrST.boundsSTArray arr)
 991     {-# INLINE newArray #-}
 992     newArray (l,u) e    = strictToLazyST (ArrST.newSTArray (l,u) e)
 993     {-# INLINE unsafeRead #-}
 994     unsafeRead arr i    = strictToLazyST (ArrST.unsafeReadSTArray arr i)
 995     {-# INLINE unsafeWrite #-}
 996     unsafeWrite arr i e = strictToLazyST (ArrST.unsafeWriteSTArray arr i e)
 997
 998 #ifdef __HUGS__
 999 INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray")
1000 #endif
1001
1002 -----------------------------------------------------------------------------
1003 -- Flat unboxed mutable arrays (ST monad)
1004
1005 -- | A mutable array with unboxed elements, that can be manipulated in
1006 -- the 'ST' monad.  The type arguments are as follows:
1007 --
1008 --  * @s@: the state variable argument for the 'ST' type
1009 --
1010 --  * @i@: the index type of the array (should be an instance of @Ix@)
1011 --
1012 --  * @e@: the element type of the array.  Only certain element types
1013 --    are supported.
1014 --
1015 -- An 'STUArray' will generally be more efficient (in terms of both time
1016 -- and space) than the equivalent boxed version ('STArray') with the same
1017 -- element type.  However, 'STUArray' is strict in its elements - so
1018 -- don\'t use 'STUArray' if you require the non-strictness that
1019 -- 'STArray' provides.
1020 #ifdef __GLASGOW_HASKELL__
1021 data STUArray s i a = STUArray !i !i (MutableByteArray# s)
1022 #endif
1023 #ifdef __HUGS__
1024 data STUArray s i a = STUArray !i !i !(MutableByteArray s)
1025 #endif
1026
1027 INSTANCE_TYPEABLE3(STUArray,stUArrayTc,"STUArray")
1028
1029 #ifdef __GLASGOW_HASKELL__
1030 instance MArray (STUArray s) Bool (ST s) where
1031     {-# INLINE getBounds #-}
1032     getBounds (STUArray l u _) = return (l,u)
1033     {-# INLINE newArray #-}
1034     newArray (l,u) init = ST $ \s1# ->
1035         case rangeSize (l,u)            of { I# n# ->
1036         case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
1037         case bOOL_WORD_SCALE n#         of { n'# ->
1038         let loop i# s3# | i# ==# n'# = s3#
1039                         | otherwise  =
1040                 case writeWordArray# marr# i# e# s3# of { s4# ->
1041                 loop (i# +# 1#) s4# } in
1042         case loop 0# s2#                of { s3# ->
1043         (# s3#, STUArray l u marr# #) }}}}
1044       where
1045         W# e# = if init then maxBound else 0
1046     {-# INLINE newArray_ #-}
1047     newArray_ (l,u) = ST $ \s1# ->
1048         case rangeSize (l,u)            of { I# n# ->
1049         case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
1050         (# s2#, STUArray l u marr# #) }}
1051     {-# INLINE unsafeRead #-}
1052     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1053         case readWordArray# marr# (bOOL_INDEX i#) s1# of { (# s2#, e# #) ->
1054         (# s2#, (e# `and#` bOOL_BIT i#) `neWord#` int2Word# 0# #) }
1055     {-# INLINE unsafeWrite #-}
1056     unsafeWrite (STUArray _ _ marr#) (I# i#) e = ST $ \s1# ->
1057         case bOOL_INDEX i#              of { j# ->
1058         case readWordArray# marr# j# s1# of { (# s2#, old# #) ->
1059         case if e then old# `or#` bOOL_BIT i#
1060              else old# `and#` bOOL_NOT_BIT i# of { e# ->
1061         case writeWordArray# marr# j# e# s2# of { s3# ->
1062         (# s3#, () #) }}}}
1063
1064 instance MArray (STUArray s) Char (ST s) where
1065     {-# INLINE getBounds #-}
1066     getBounds (STUArray l u _) = return (l,u)
1067     {-# INLINE newArray_ #-}
1068     newArray_ (l,u) = ST $ \s1# ->
1069         case rangeSize (l,u)            of { I# n# ->
1070         case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
1071         (# s2#, STUArray l u marr# #) }}
1072     {-# INLINE unsafeRead #-}
1073     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1074         case readWideCharArray# marr# i# s1# of { (# s2#, e# #) ->
1075         (# s2#, C# e# #) }
1076     {-# INLINE unsafeWrite #-}
1077     unsafeWrite (STUArray _ _ marr#) (I# i#) (C# e#) = ST $ \s1# ->
1078         case writeWideCharArray# marr# i# e# s1# of { s2# ->
1079         (# s2#, () #) }
1080
1081 instance MArray (STUArray s) Int (ST s) where
1082     {-# INLINE getBounds #-}
1083     getBounds (STUArray l u _) = return (l,u)
1084     {-# INLINE newArray_ #-}
1085     newArray_ (l,u) = ST $ \s1# ->
1086         case rangeSize (l,u)            of { I# n# ->
1087         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1088         (# s2#, STUArray l u marr# #) }}
1089     {-# INLINE unsafeRead #-}
1090     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1091         case readIntArray# marr# i# s1# of { (# s2#, e# #) ->
1092         (# s2#, I# e# #) }
1093     {-# INLINE unsafeWrite #-}
1094     unsafeWrite (STUArray _ _ marr#) (I# i#) (I# e#) = ST $ \s1# ->
1095         case writeIntArray# marr# i# e# s1# of { s2# ->
1096         (# s2#, () #) }
1097
1098 instance MArray (STUArray s) Word (ST s) where
1099     {-# INLINE getBounds #-}
1100     getBounds (STUArray l u _) = return (l,u)
1101     {-# INLINE newArray_ #-}
1102     newArray_ (l,u) = ST $ \s1# ->
1103         case rangeSize (l,u)            of { I# n# ->
1104         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1105         (# s2#, STUArray l u marr# #) }}
1106     {-# INLINE unsafeRead #-}
1107     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1108         case readWordArray# marr# i# s1# of { (# s2#, e# #) ->
1109         (# s2#, W# e# #) }
1110     {-# INLINE unsafeWrite #-}
1111     unsafeWrite (STUArray _ _ marr#) (I# i#) (W# e#) = ST $ \s1# ->
1112         case writeWordArray# marr# i# e# s1# of { s2# ->
1113         (# s2#, () #) }
1114
1115 instance MArray (STUArray s) (Ptr a) (ST s) where
1116     {-# INLINE getBounds #-}
1117     getBounds (STUArray l u _) = return (l,u)
1118     {-# INLINE newArray_ #-}
1119     newArray_ (l,u) = ST $ \s1# ->
1120         case rangeSize (l,u)            of { I# n# ->
1121         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1122         (# s2#, STUArray l u marr# #) }}
1123     {-# INLINE unsafeRead #-}
1124     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1125         case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
1126         (# s2#, Ptr e# #) }
1127     {-# INLINE unsafeWrite #-}
1128     unsafeWrite (STUArray _ _ marr#) (I# i#) (Ptr e#) = ST $ \s1# ->
1129         case writeAddrArray# marr# i# e# s1# of { s2# ->
1130         (# s2#, () #) }
1131
1132 instance MArray (STUArray s) (FunPtr a) (ST s) where
1133     {-# INLINE getBounds #-}
1134     getBounds (STUArray l u _) = return (l,u)
1135     {-# INLINE newArray_ #-}
1136     newArray_ (l,u) = ST $ \s1# ->
1137         case rangeSize (l,u)            of { I# n# ->
1138         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1139         (# s2#, STUArray l u marr# #) }}
1140     {-# INLINE unsafeRead #-}
1141     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1142         case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
1143         (# s2#, FunPtr e# #) }
1144     {-# INLINE unsafeWrite #-}
1145     unsafeWrite (STUArray _ _ marr#) (I# i#) (FunPtr e#) = ST $ \s1# ->
1146         case writeAddrArray# marr# i# e# s1# of { s2# ->
1147         (# s2#, () #) }
1148
1149 instance MArray (STUArray s) Float (ST s) where
1150     {-# INLINE getBounds #-}
1151     getBounds (STUArray l u _) = return (l,u)
1152     {-# INLINE newArray_ #-}
1153     newArray_ (l,u) = ST $ \s1# ->
1154         case rangeSize (l,u)            of { I# n# ->
1155         case newByteArray# (fLOAT_SCALE n#) s1# of { (# s2#, marr# #) ->
1156         (# s2#, STUArray l u marr# #) }}
1157     {-# INLINE unsafeRead #-}
1158     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1159         case readFloatArray# marr# i# s1# of { (# s2#, e# #) ->
1160         (# s2#, F# e# #) }
1161     {-# INLINE unsafeWrite #-}
1162     unsafeWrite (STUArray _ _ marr#) (I# i#) (F# e#) = ST $ \s1# ->
1163         case writeFloatArray# marr# i# e# s1# of { s2# ->
1164         (# s2#, () #) }
1165
1166 instance MArray (STUArray s) Double (ST s) where
1167     {-# INLINE getBounds #-}
1168     getBounds (STUArray l u _) = return (l,u)
1169     {-# INLINE newArray_ #-}
1170     newArray_ (l,u) = ST $ \s1# ->
1171         case rangeSize (l,u)            of { I# n# ->
1172         case newByteArray# (dOUBLE_SCALE n#) s1# of { (# s2#, marr# #) ->
1173         (# s2#, STUArray l u marr# #) }}
1174     {-# INLINE unsafeRead #-}
1175     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1176         case readDoubleArray# marr# i# s1# of { (# s2#, e# #) ->
1177         (# s2#, D# e# #) }
1178     {-# INLINE unsafeWrite #-}
1179     unsafeWrite (STUArray _ _ marr#) (I# i#) (D# e#) = ST $ \s1# ->
1180         case writeDoubleArray# marr# i# e# s1# of { s2# ->
1181         (# s2#, () #) }
1182
1183 instance MArray (STUArray s) (StablePtr a) (ST s) where
1184     {-# INLINE getBounds #-}
1185     getBounds (STUArray l u _) = return (l,u)
1186     {-# INLINE newArray_ #-}
1187     newArray_ (l,u) = ST $ \s1# ->
1188         case rangeSize (l,u)            of { I# n# ->
1189         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1190         (# s2#, STUArray l u marr# #) }}
1191     {-# INLINE unsafeRead #-}
1192     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1193         case readStablePtrArray# marr# i# s1# of { (# s2#, e# #) ->
1194         (# s2# , StablePtr e# #) }
1195     {-# INLINE unsafeWrite #-}
1196     unsafeWrite (STUArray _ _ marr#) (I# i#) (StablePtr e#) = ST $ \s1# ->
1197         case writeStablePtrArray# marr# i# e# s1# of { s2# ->
1198         (# s2#, () #) }
1199
1200 instance MArray (STUArray s) Int8 (ST s) where
1201     {-# INLINE getBounds #-}
1202     getBounds (STUArray l u _) = return (l,u)
1203     {-# INLINE newArray_ #-}
1204     newArray_ (l,u) = ST $ \s1# ->
1205         case rangeSize (l,u)            of { I# n# ->
1206         case newByteArray# n# s1#       of { (# s2#, marr# #) ->
1207         (# s2#, STUArray l u marr# #) }}
1208     {-# INLINE unsafeRead #-}
1209     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1210         case readInt8Array# marr# i# s1# of { (# s2#, e# #) ->
1211         (# s2#, I8# e# #) }
1212     {-# INLINE unsafeWrite #-}
1213     unsafeWrite (STUArray _ _ marr#) (I# i#) (I8# e#) = ST $ \s1# ->
1214         case writeInt8Array# marr# i# e# s1# of { s2# ->
1215         (# s2#, () #) }
1216
1217 instance MArray (STUArray s) Int16 (ST s) where
1218     {-# INLINE getBounds #-}
1219     getBounds (STUArray l u _) = return (l,u)
1220     {-# INLINE newArray_ #-}
1221     newArray_ (l,u) = ST $ \s1# ->
1222         case rangeSize (l,u)            of { I# n# ->
1223         case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) ->
1224         (# s2#, STUArray l u marr# #) }}
1225     {-# INLINE unsafeRead #-}
1226     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1227         case readInt16Array# marr# i# s1# of { (# s2#, e# #) ->
1228         (# s2#, I16# e# #) }
1229     {-# INLINE unsafeWrite #-}
1230     unsafeWrite (STUArray _ _ marr#) (I# i#) (I16# e#) = ST $ \s1# ->
1231         case writeInt16Array# marr# i# e# s1# of { s2# ->
1232         (# s2#, () #) }
1233
1234 instance MArray (STUArray s) Int32 (ST s) where
1235     {-# INLINE getBounds #-}
1236     getBounds (STUArray l u _) = return (l,u)
1237     {-# INLINE newArray_ #-}
1238     newArray_ (l,u) = ST $ \s1# ->
1239         case rangeSize (l,u)            of { I# n# ->
1240         case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
1241         (# s2#, STUArray l u marr# #) }}
1242     {-# INLINE unsafeRead #-}
1243     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1244         case readInt32Array# marr# i# s1# of { (# s2#, e# #) ->
1245         (# s2#, I32# e# #) }
1246     {-# INLINE unsafeWrite #-}
1247     unsafeWrite (STUArray _ _ marr#) (I# i#) (I32# e#) = ST $ \s1# ->
1248         case writeInt32Array# marr# i# e# s1# of { s2# ->
1249         (# s2#, () #) }
1250
1251 instance MArray (STUArray s) Int64 (ST s) where
1252     {-# INLINE getBounds #-}
1253     getBounds (STUArray l u _) = return (l,u)
1254     {-# INLINE newArray_ #-}
1255     newArray_ (l,u) = ST $ \s1# ->
1256         case rangeSize (l,u)            of { I# n# ->
1257         case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) ->
1258         (# s2#, STUArray l u marr# #) }}
1259     {-# INLINE unsafeRead #-}
1260     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1261         case readInt64Array# marr# i# s1# of { (# s2#, e# #) ->
1262         (# s2#, I64# e# #) }
1263     {-# INLINE unsafeWrite #-}
1264     unsafeWrite (STUArray _ _ marr#) (I# i#) (I64# e#) = ST $ \s1# ->
1265         case writeInt64Array# marr# i# e# s1# of { s2# ->
1266         (# s2#, () #) }
1267
1268 instance MArray (STUArray s) Word8 (ST s) where
1269     {-# INLINE getBounds #-}
1270     getBounds (STUArray l u _) = return (l,u)
1271     {-# INLINE newArray_ #-}
1272     newArray_ (l,u) = ST $ \s1# ->
1273         case rangeSize (l,u)            of { I# n# ->
1274         case newByteArray# n# s1#       of { (# s2#, marr# #) ->
1275         (# s2#, STUArray l u marr# #) }}
1276     {-# INLINE unsafeRead #-}
1277     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1278         case readWord8Array# marr# i# s1# of { (# s2#, e# #) ->
1279         (# s2#, W8# e# #) }
1280     {-# INLINE unsafeWrite #-}
1281     unsafeWrite (STUArray _ _ marr#) (I# i#) (W8# e#) = ST $ \s1# ->
1282         case writeWord8Array# marr# i# e# s1# of { s2# ->
1283         (# s2#, () #) }
1284
1285 instance MArray (STUArray s) Word16 (ST s) where
1286     {-# INLINE getBounds #-}
1287     getBounds (STUArray l u _) = return (l,u)
1288     {-# INLINE newArray_ #-}
1289     newArray_ (l,u) = ST $ \s1# ->
1290         case rangeSize (l,u)            of { I# n# ->
1291         case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) ->
1292         (# s2#, STUArray l u marr# #) }}
1293     {-# INLINE unsafeRead #-}
1294     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1295         case readWord16Array# marr# i# s1# of { (# s2#, e# #) ->
1296         (# s2#, W16# e# #) }
1297     {-# INLINE unsafeWrite #-}
1298     unsafeWrite (STUArray _ _ marr#) (I# i#) (W16# e#) = ST $ \s1# ->
1299         case writeWord16Array# marr# i# e# s1# of { s2# ->
1300         (# s2#, () #) }
1301
1302 instance MArray (STUArray s) Word32 (ST s) where
1303     {-# INLINE getBounds #-}
1304     getBounds (STUArray l u _) = return (l,u)
1305     {-# INLINE newArray_ #-}
1306     newArray_ (l,u) = ST $ \s1# ->
1307         case rangeSize (l,u)            of { I# n# ->
1308         case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
1309         (# s2#, STUArray l u marr# #) }}
1310     {-# INLINE unsafeRead #-}
1311     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1312         case readWord32Array# marr# i# s1# of { (# s2#, e# #) ->
1313         (# s2#, W32# e# #) }
1314     {-# INLINE unsafeWrite #-}
1315     unsafeWrite (STUArray _ _ marr#) (I# i#) (W32# e#) = ST $ \s1# ->
1316         case writeWord32Array# marr# i# e# s1# of { s2# ->
1317         (# s2#, () #) }
1318
1319 instance MArray (STUArray s) Word64 (ST s) where
1320     {-# INLINE getBounds #-}
1321     getBounds (STUArray l u _) = return (l,u)
1322     {-# INLINE newArray_ #-}
1323     newArray_ (l,u) = ST $ \s1# ->
1324         case rangeSize (l,u)            of { I# n# ->
1325         case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) ->
1326         (# s2#, STUArray l u marr# #) }}
1327     {-# INLINE unsafeRead #-}
1328     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1329         case readWord64Array# marr# i# s1# of { (# s2#, e# #) ->
1330         (# s2#, W64# e# #) }
1331     {-# INLINE unsafeWrite #-}
1332     unsafeWrite (STUArray _ _ marr#) (I# i#) (W64# e#) = ST $ \s1# ->
1333         case writeWord64Array# marr# i# e# s1# of { s2# ->
1334         (# s2#, () #) }
1335
1336 -----------------------------------------------------------------------------
1337 -- Translation between elements and bytes
1338
1339 bOOL_SCALE, bOOL_WORD_SCALE,
1340   wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int#
1341 bOOL_SCALE n# = (n# +# last#) `uncheckedIShiftRA#` 3#
1342   where I# last# = SIZEOF_HSWORD * 8 - 1
1343 bOOL_WORD_SCALE n# = bOOL_INDEX (n# +# last#)
1344   where I# last# = SIZEOF_HSWORD * 8 - 1
1345 wORD_SCALE   n# = scale# *# n# where I# scale# = SIZEOF_HSWORD
1346 dOUBLE_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSDOUBLE
1347 fLOAT_SCALE  n# = scale# *# n# where I# scale# = SIZEOF_HSFLOAT
1348
1349 bOOL_INDEX :: Int# -> Int#
1350 #if SIZEOF_HSWORD == 4
1351 bOOL_INDEX i# = i# `uncheckedIShiftRA#` 5#
1352 #elif SIZEOF_HSWORD == 8
1353 bOOL_INDEX i# = i# `uncheckedIShiftRA#` 6#
1354 #endif
1355
1356 bOOL_BIT, bOOL_NOT_BIT :: Int# -> Word#
1357 bOOL_BIT     n# = int2Word# 1# `uncheckedShiftL#` (word2Int# (int2Word# n# `and#` mask#))
1358   where W# mask# = SIZEOF_HSWORD * 8 - 1
1359 bOOL_NOT_BIT n# = bOOL_BIT n# `xor#` mb# where W# mb# = maxBound
1360 #endif /* __GLASGOW_HASKELL__ */
1361
1362 #ifdef __HUGS__
1363 newMBArray_ :: (Ix i, Storable e) => (i,i) -> ST s (STUArray s i e)
1364 newMBArray_ = makeArray undefined
1365   where
1366     makeArray :: (Ix i, Storable e) => e -> (i,i) -> ST s (STUArray s i e)
1367     makeArray dummy (l,u) = do
1368         marr <- newMutableByteArray (rangeSize (l,u) * sizeOf dummy)
1369         return (STUArray l u marr)
1370
1371 unsafeReadMBArray :: Storable e => STUArray s i e -> Int -> ST s e
1372 unsafeReadMBArray (STUArray _ _ marr) = readMutableByteArray marr
1373
1374 unsafeWriteMBArray :: Storable e => STUArray s i e -> Int -> e -> ST s ()
1375 unsafeWriteMBArray (STUArray _ _ marr) = writeMutableByteArray marr
1376
1377 getBoundsMBArray (STUArray l u _) = return (l,u)
1378
1379 instance MArray (STUArray s) Bool (ST s) where
1380     getBounds = getBoundsMBArray
1381     newArray_ (l,u) = do
1382         marr <- newMutableByteArray (bOOL_SCALE (rangeSize (l,u)))
1383         return (STUArray l u marr)
1384     unsafeRead (STUArray _ _ marr) i = do
1385         let ix = bOOL_INDEX i
1386             bit = bOOL_SUBINDEX i
1387         w <- readMutableByteArray marr ix
1388         return (testBit (w::BitSet) bit)
1389     unsafeWrite (STUArray _ _ marr) i e = do
1390         let ix = bOOL_INDEX i
1391             bit = bOOL_SUBINDEX i
1392         w <- readMutableByteArray marr ix
1393         writeMutableByteArray marr ix
1394             (if e then setBit (w::BitSet) bit else clearBit w bit)
1395
1396 instance MArray (STUArray s) Char (ST s) where
1397     getBounds = getBoundsMBArray
1398     newArray_ = newMBArray_
1399     unsafeRead = unsafeReadMBArray
1400     unsafeWrite = unsafeWriteMBArray
1401
1402 instance MArray (STUArray s) Int (ST s) where
1403     getBounds = getBoundsMBArray
1404     newArray_ = newMBArray_
1405     unsafeRead = unsafeReadMBArray
1406     unsafeWrite = unsafeWriteMBArray
1407
1408 instance MArray (STUArray s) Word (ST s) where
1409     getBounds = getBoundsMBArray
1410     newArray_ = newMBArray_
1411     unsafeRead = unsafeReadMBArray
1412     unsafeWrite = unsafeWriteMBArray
1413
1414 instance MArray (STUArray s) (Ptr a) (ST s) where
1415     getBounds = getBoundsMBArray
1416     newArray_ = newMBArray_
1417     unsafeRead = unsafeReadMBArray
1418     unsafeWrite = unsafeWriteMBArray
1419
1420 instance MArray (STUArray s) (FunPtr a) (ST s) where
1421     getBounds = getBoundsMBArray
1422     newArray_ = newMBArray_
1423     unsafeRead = unsafeReadMBArray
1424     unsafeWrite = unsafeWriteMBArray
1425
1426 instance MArray (STUArray s) Float (ST s) where
1427     getBounds = getBoundsMBArray
1428     newArray_ = newMBArray_
1429     unsafeRead = unsafeReadMBArray
1430     unsafeWrite = unsafeWriteMBArray
1431
1432 instance MArray (STUArray s) Double (ST s) where
1433     getBounds = getBoundsMBArray
1434     newArray_ = newMBArray_
1435     unsafeRead = unsafeReadMBArray
1436     unsafeWrite = unsafeWriteMBArray
1437
1438 instance MArray (STUArray s) (StablePtr a) (ST s) where
1439     getBounds = getBoundsMBArray
1440     newArray_ = newMBArray_
1441     unsafeRead = unsafeReadMBArray
1442     unsafeWrite = unsafeWriteMBArray
1443
1444 instance MArray (STUArray s) Int8 (ST s) where
1445     getBounds = getBoundsMBArray
1446     newArray_ = newMBArray_
1447     unsafeRead = unsafeReadMBArray
1448     unsafeWrite = unsafeWriteMBArray
1449
1450 instance MArray (STUArray s) Int16 (ST s) where
1451     getBounds = getBoundsMBArray
1452     newArray_ = newMBArray_
1453     unsafeRead = unsafeReadMBArray
1454     unsafeWrite = unsafeWriteMBArray
1455
1456 instance MArray (STUArray s) Int32 (ST s) where
1457     getBounds = getBoundsMBArray
1458     newArray_ = newMBArray_
1459     unsafeRead = unsafeReadMBArray
1460     unsafeWrite = unsafeWriteMBArray
1461
1462 instance MArray (STUArray s) Int64 (ST s) where
1463     getBounds = getBoundsMBArray
1464     newArray_ = newMBArray_
1465     unsafeRead = unsafeReadMBArray
1466     unsafeWrite = unsafeWriteMBArray
1467
1468 instance MArray (STUArray s) Word8 (ST s) where
1469     getBounds = getBoundsMBArray
1470     newArray_ = newMBArray_
1471     unsafeRead = unsafeReadMBArray
1472     unsafeWrite = unsafeWriteMBArray
1473
1474 instance MArray (STUArray s) Word16 (ST s) where
1475     getBounds = getBoundsMBArray
1476     newArray_ = newMBArray_
1477     unsafeRead = unsafeReadMBArray
1478     unsafeWrite = unsafeWriteMBArray
1479
1480 instance MArray (STUArray s) Word32 (ST s) where
1481     getBounds = getBoundsMBArray
1482     newArray_ = newMBArray_
1483     unsafeRead = unsafeReadMBArray
1484     unsafeWrite = unsafeWriteMBArray
1485
1486 instance MArray (STUArray s) Word64 (ST s) where
1487     getBounds = getBoundsMBArray
1488     newArray_ = newMBArray_
1489     unsafeRead = unsafeReadMBArray
1490     unsafeWrite = unsafeWriteMBArray
1491
1492 type BitSet = Word8
1493
1494 bitSetSize = bitSize (0::BitSet)
1495
1496 bOOL_SCALE :: Int -> Int
1497 bOOL_SCALE n = (n + bitSetSize - 1) `div` bitSetSize
1498
1499 bOOL_INDEX :: Int -> Int
1500 bOOL_INDEX i = i `div` bitSetSize
1501
1502 bOOL_SUBINDEX :: Int -> Int
1503 bOOL_SUBINDEX i = i `mod` bitSetSize
1504 #endif /* __HUGS__ */
1505
1506 -----------------------------------------------------------------------------
1507 -- Freezing
1508
1509 -- | Converts a mutable array (any instance of 'MArray') to an
1510 -- immutable array (any instance of 'IArray') by taking a complete
1511 -- copy of it.
1512 freeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
1513 freeze marr = do
1514   (l,u) <- getBounds marr
1515   ies <- sequence [do e <- unsafeRead marr i; return (i,e)
1516                    | i <- [0 .. rangeSize (l,u) - 1]]
1517   return (unsafeArray (l,u) ies)
1518
1519 #ifdef __GLASGOW_HASKELL__
1520 freezeSTUArray :: Ix i => STUArray s i e -> ST s (UArray i e)
1521 freezeSTUArray (STUArray l u marr#) = ST $ \s1# ->
1522     case sizeofMutableByteArray# marr#  of { n# ->
1523     case newByteArray# n# s1#           of { (# s2#, marr'# #) ->
1524     case memcpy_freeze marr'# marr# (fromIntegral (I# n#)) of { IO m ->
1525     case unsafeCoerce# m s2#            of { (# s3#, _ #) ->
1526     case unsafeFreezeByteArray# marr'# s3# of { (# s4#, arr# #) ->
1527     (# s4#, UArray l u arr# #) }}}}}
1528
1529 foreign import ccall unsafe "memcpy"
1530     memcpy_freeze :: MutableByteArray# s -> MutableByteArray# s -> CSize
1531            -> IO (Ptr a)
1532
1533 {-# RULES
1534 "freeze/STArray"  freeze = ArrST.freezeSTArray
1535 "freeze/STUArray" freeze = freezeSTUArray
1536     #-}
1537 #endif /* __GLASGOW_HASKELL__ */
1538
1539 -- In-place conversion of mutable arrays to immutable ones places
1540 -- a proof obligation on the user: no other parts of your code can
1541 -- have a reference to the array at the point where you unsafely
1542 -- freeze it (and, subsequently mutate it, I suspect).
1543
1544 {- |
1545    Converts an mutable array into an immutable array.  The
1546    implementation may either simply cast the array from
1547    one type to the other without copying the array, or it
1548    may take a full copy of the array.
1549
1550    Note that because the array is possibly not copied, any subsequent
1551    modifications made to the mutable version of the array may be
1552    shared with the immutable version.  It is safe to use, therefore, if
1553    the mutable version is never modified after the freeze operation.
1554
1555    The non-copying implementation is supported between certain pairs
1556    of array types only; one constraint is that the array types must
1557    have identical representations.  In GHC, The following pairs of
1558    array types have a non-copying O(1) implementation of
1559    'unsafeFreeze'.  Because the optimised versions are enabled by
1560    specialisations, you will need to compile with optimisation (-O) to
1561    get them.
1562
1563      * 'Data.Array.IO.IOUArray' -> 'Data.Array.Unboxed.UArray'
1564
1565      * 'Data.Array.ST.STUArray' -> 'Data.Array.Unboxed.UArray'
1566
1567      * 'Data.Array.IO.IOArray' -> 'Data.Array.Array'
1568
1569      * 'Data.Array.ST.STArray' -> 'Data.Array.Array'
1570 -}
1571 {-# INLINE unsafeFreeze #-}
1572 unsafeFreeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
1573 unsafeFreeze = freeze
1574
1575 {-# RULES
1576 "unsafeFreeze/STArray"  unsafeFreeze = ArrST.unsafeFreezeSTArray
1577 "unsafeFreeze/STUArray" unsafeFreeze = unsafeFreezeSTUArray
1578     #-}
1579
1580 -----------------------------------------------------------------------------
1581 -- Thawing
1582
1583 -- | Converts an immutable array (any instance of 'IArray') into a
1584 -- mutable array (any instance of 'MArray') by taking a complete copy
1585 -- of it.
1586 thaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
1587 thaw arr = case bounds arr of
1588   (l,u) -> do
1589     marr <- newArray_ (l,u)
1590     sequence_ [unsafeWrite marr i (unsafeAt arr i)
1591                | i <- [0 .. rangeSize (l,u) - 1]]
1592     return marr
1593
1594 #ifdef __GLASGOW_HASKELL__
1595 thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1596 thawSTUArray (UArray l u arr#) = ST $ \s1# ->
1597     case sizeofByteArray# arr#          of { n# ->
1598     case newByteArray# n# s1#           of { (# s2#, marr# #) ->
1599     case memcpy_thaw marr# arr# (fromIntegral (I# n#)) of { IO m ->
1600     case unsafeCoerce# m s2#            of { (# s3#, _ #) ->
1601     (# s3#, STUArray l u marr# #) }}}}
1602
1603 foreign import ccall unsafe "memcpy"
1604     memcpy_thaw :: MutableByteArray# s -> ByteArray# -> CSize
1605            -> IO (Ptr a)
1606
1607 {-# RULES
1608 "thaw/STArray"  thaw = ArrST.thawSTArray
1609 "thaw/STUArray" thaw = thawSTUArray
1610     #-}
1611 #endif /* __GLASGOW_HASKELL__ */
1612
1613 #ifdef __HUGS__
1614 thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1615 thawSTUArray (UArray l u arr) = do
1616     marr <- thawByteArray arr
1617     return (STUArray l u marr)
1618 #endif
1619
1620 -- In-place conversion of immutable arrays to mutable ones places
1621 -- a proof obligation on the user: no other parts of your code can
1622 -- have a reference to the array at the point where you unsafely
1623 -- thaw it (and, subsequently mutate it, I suspect).
1624
1625 {- |
1626    Converts an immutable array into a mutable array.  The
1627    implementation may either simply cast the array from
1628    one type to the other without copying the array, or it
1629    may take a full copy of the array.
1630
1631    Note that because the array is possibly not copied, any subsequent
1632    modifications made to the mutable version of the array may be
1633    shared with the immutable version.  It is only safe to use,
1634    therefore, if the immutable array is never referenced again in this
1635    thread, and there is no possibility that it can be also referenced
1636    in another thread.  If you use an unsafeThaw/write/unsafeFreeze
1637    sequence in a multi-threaded setting, then you must ensure that
1638    this sequence is atomic with respect to other threads, or a garbage
1639    collector crash may result (because the write may be writing to a
1640    frozen array).
1641
1642    The non-copying implementation is supported between certain pairs
1643    of array types only; one constraint is that the array types must
1644    have identical representations.  In GHC, The following pairs of
1645    array types have a non-copying O(1) implementation of
1646    'unsafeThaw'.  Because the optimised versions are enabled by
1647    specialisations, you will need to compile with optimisation (-O) to
1648    get them.
1649
1650      * 'Data.Array.Unboxed.UArray' -> 'Data.Array.IO.IOUArray'
1651
1652      * 'Data.Array.Unboxed.UArray' -> 'Data.Array.ST.STUArray'
1653
1654      * 'Data.Array.Array'  -> 'Data.Array.IO.IOArray'
1655
1656      * 'Data.Array.Array'  -> 'Data.Array.ST.STArray'
1657 -}
1658 {-# INLINE unsafeThaw #-}
1659 unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
1660 unsafeThaw = thaw
1661
1662 #ifdef __GLASGOW_HASKELL__
1663 {-# INLINE unsafeThawSTUArray #-}
1664 unsafeThawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1665 unsafeThawSTUArray (UArray l u marr#) =
1666     return (STUArray l u (unsafeCoerce# marr#))
1667
1668 {-# RULES
1669 "unsafeThaw/STArray"    unsafeThaw = ArrST.unsafeThawSTArray
1670 "unsafeThaw/STUArray"   unsafeThaw = unsafeThawSTUArray
1671     #-}
1672 #endif /* __GLASGOW_HASKELL__ */
1673
1674 -- | Casts an 'STUArray' with one element type into one with a
1675 -- different element type.  All the elements of the resulting array
1676 -- are undefined (unless you know what you\'re doing...).
1677
1678 #ifdef __GLASGOW_HASKELL__
1679 castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
1680 castSTUArray (STUArray l u marr#) = return (STUArray l u marr#)
1681 #endif
1682
1683 #ifdef __HUGS__
1684 castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
1685 castSTUArray (STUArray l u marr) = return (STUArray l u marr)
1686 #endif