Data/Array/Base.hs

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