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