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