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