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