Data/Array/Base.hs

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