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