Data/Array/Base.hs

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