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 (UArray ix Bool) where
 813     (==) = eqUArray
 814
 815 instance Ix ix => Eq (UArray ix Char) where
 816     (==) = eqUArray
 817
 818 instance Ix ix => Eq (UArray ix Int) where
 819     (==) = eqUArray
 820
 821 instance Ix ix => Eq (UArray ix Word) where
 822     (==) = eqUArray
 823
 824 instance Ix ix => Eq (UArray ix (Ptr a)) where
 825     (==) = eqUArray
 826
 827 instance Ix ix => Eq (UArray ix (FunPtr a)) where
 828     (==) = eqUArray
 829
 830 instance Ix ix => Eq (UArray ix Float) where
 831     (==) = eqUArray
 832
 833 instance Ix ix => Eq (UArray ix Double) where
 834     (==) = eqUArray
 835
 836 #ifdef __GLASGOW_HASKELL__
 837 instance Ix ix => Eq (UArray ix (StablePtr a)) where
 838     (==) = eqUArray
 839 #endif
 840
 841 instance Ix ix => Eq (UArray ix Int8) where
 842     (==) = eqUArray
 843
 844 instance Ix ix => Eq (UArray ix Int16) where
 845     (==) = eqUArray
 846
 847 instance Ix ix => Eq (UArray ix Int32) where
 848     (==) = eqUArray
 849
 850 instance Ix ix => Eq (UArray ix Int64) where
 851     (==) = eqUArray
 852
 853 instance Ix ix => Eq (UArray ix Word8) where
 854     (==) = eqUArray
 855
 856 instance Ix ix => Eq (UArray ix Word16) where
 857     (==) = eqUArray
 858
 859 instance Ix ix => Eq (UArray ix Word32) where
 860     (==) = eqUArray
 861
 862 instance Ix ix => Eq (UArray ix Word64) where
 863     (==) = eqUArray
 864
 865 instance Ix ix => Ord (UArray ix Bool) where
 866     compare = cmpUArray
 867
 868 instance Ix ix => Ord (UArray ix Char) where
 869     compare = cmpUArray
 870
 871 instance Ix ix => Ord (UArray ix Int) where
 872     compare = cmpUArray
 873
 874 instance Ix ix => Ord (UArray ix Word) where
 875     compare = cmpUArray
 876
 877 instance Ix ix => Ord (UArray ix (Ptr a)) where
 878     compare = cmpUArray
 879
 880 instance Ix ix => Ord (UArray ix (FunPtr a)) where
 881     compare = cmpUArray
 882
 883 instance Ix ix => Ord (UArray ix Float) where
 884     compare = cmpUArray
 885
 886 instance Ix ix => Ord (UArray ix Double) where
 887     compare = cmpUArray
 888
 889 instance Ix ix => Ord (UArray ix Int8) where
 890     compare = cmpUArray
 891
 892 instance Ix ix => Ord (UArray ix Int16) where
 893     compare = cmpUArray
 894
 895 instance Ix ix => Ord (UArray ix Int32) where
 896     compare = cmpUArray
 897
 898 instance Ix ix => Ord (UArray ix Int64) where
 899     compare = cmpUArray
 900
 901 instance Ix ix => Ord (UArray ix Word8) where
 902     compare = cmpUArray
 903
 904 instance Ix ix => Ord (UArray ix Word16) where
 905     compare = cmpUArray
 906
 907 instance Ix ix => Ord (UArray ix Word32) where
 908     compare = cmpUArray
 909
 910 instance Ix ix => Ord (UArray ix Word64) where
 911     compare = cmpUArray
 912
 913 instance (Ix ix, Show ix) => Show (UArray ix Bool) where
 914     showsPrec = showsIArray
 915
 916 instance (Ix ix, Show ix) => Show (UArray ix Char) where
 917     showsPrec = showsIArray
 918
 919 instance (Ix ix, Show ix) => Show (UArray ix Int) where
 920     showsPrec = showsIArray
 921
 922 instance (Ix ix, Show ix) => Show (UArray ix Word) where
 923     showsPrec = showsIArray
 924
 925 instance (Ix ix, Show ix) => Show (UArray ix Float) where
 926     showsPrec = showsIArray
 927
 928 instance (Ix ix, Show ix) => Show (UArray ix Double) where
 929     showsPrec = showsIArray
 930
 931 instance (Ix ix, Show ix) => Show (UArray ix Int8) where
 932     showsPrec = showsIArray
 933
 934 instance (Ix ix, Show ix) => Show (UArray ix Int16) where
 935     showsPrec = showsIArray
 936
 937 instance (Ix ix, Show ix) => Show (UArray ix Int32) where
 938     showsPrec = showsIArray
 939
 940 instance (Ix ix, Show ix) => Show (UArray ix Int64) where
 941     showsPrec = showsIArray
 942
 943 instance (Ix ix, Show ix) => Show (UArray ix Word8) where
 944     showsPrec = showsIArray
 945
 946 instance (Ix ix, Show ix) => Show (UArray ix Word16) where
 947     showsPrec = showsIArray
 948
 949 instance (Ix ix, Show ix) => Show (UArray ix Word32) where
 950     showsPrec = showsIArray
 951
 952 instance (Ix ix, Show ix) => Show (UArray ix Word64) where
 953     showsPrec = showsIArray
 954
 955 -----------------------------------------------------------------------------
 956 -- Mutable arrays
 957
 958 {-# NOINLINE arrEleBottom #-}
 959 arrEleBottom :: a
 960 arrEleBottom = error "MArray: undefined array element"
 961
 962 {-| Class of mutable array types.
 963
 964 An array type has the form @(a i e)@ where @a@ is the array type
 965 constructor (kind @* -> * -> *@), @i@ is the index type (a member of
 966 the class 'Ix'), and @e@ is the element type.
 967
 968 The @MArray@ class is parameterised over both @a@ and @e@ (so that
 969 instances specialised to certain element types can be defined, in the
 970 same way as for 'IArray'), and also over the type of the monad, @m@,
 971 in which the mutable array will be manipulated.
 972 -}
 973 class (HasBounds a, Monad m) => MArray a e m where
 974
 975     -- | Builds a new array, with every element initialised to the supplied
 976     -- value.
 977     newArray    :: Ix i => (i,i) -> e -> m (a i e)
 978
 979     -- | Builds a new array, with every element initialised to undefined.
 980     newArray_   :: Ix i => (i,i) -> m (a i e)
 981
 982     unsafeRead  :: Ix i => a i e -> Int -> m e
 983     unsafeWrite :: Ix i => a i e -> Int -> e -> m ()
 984
 985     {-# INLINE newArray #-}
 986         -- The INLINE is crucial, because until we know at least which monad
 987         -- we are in, the code below allocates like crazy.  So inline it,
 988         -- in the hope that the context will know the monad.
 989     newArray (l,u) init = do
 990         marr <- newArray_ (l,u)
 991         sequence_ [unsafeWrite marr i init | i <- [0 .. rangeSize (l,u) - 1]]
 992         return marr
 993
 994     newArray_ (l,u) = newArray (l,u) arrEleBottom
 995
 996     -- newArray takes an initialiser which all elements of
 997     -- the newly created array are initialised to.  newArray_ takes
 998     -- no initialiser, it is assumed that the array is initialised with
 999     -- "undefined" values.
1000
1001     -- why not omit newArray_?  Because in the unboxed array case we would
1002     -- like to omit the initialisation altogether if possible.  We can't do
1003     -- this for boxed arrays, because the elements must all have valid values
1004     -- at all times in case of garbage collection.
1005
1006     -- why not omit newArray?  Because in the boxed case, we can omit the
1007     -- default initialisation with undefined values if we *do* know the
1008     -- initial value and it is constant for all elements.
1009
1010 {-# INLINE newListArray #-}
1011 -- | Constructs a mutable array from a list of initial elements.
1012 -- The list gives the elements of the array in ascending order
1013 -- beginning with the lowest index.
1014 newListArray :: (MArray a e m, Ix i) => (i,i) -> [e] -> m (a i e)
1015 newListArray (l,u) es = do
1016     marr <- newArray_ (l,u)
1017     let n = rangeSize (l,u)
1018     let fillFromList i xs | i == n    = return ()
1019                           | otherwise = case xs of
1020             []   -> return ()
1021             y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys
1022     fillFromList 0 es
1023     return marr
1024
1025 {-# INLINE readArray #-}
1026 -- | Read an element from a mutable array
1027 readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
1028 readArray marr i = case bounds marr of
1029     (l,u) -> unsafeRead marr (index (l,u) i)
1030
1031 {-# INLINE writeArray #-}
1032 -- | Write an element in a mutable array
1033 writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
1034 writeArray marr i e = case bounds marr of
1035     (l,u) -> unsafeWrite marr (index (l,u) i) e
1036
1037 {-# INLINE getElems #-}
1038 -- | Return a list of all the elements of a mutable array
1039 getElems :: (MArray a e m, Ix i) => a i e -> m [e]
1040 getElems marr = case bounds marr of
1041     (l,u) -> sequence [unsafeRead marr i | i <- [0 .. rangeSize (l,u) - 1]]
1042
1043 {-# INLINE getAssocs #-}
1044 -- | Return a list of all the associations of a mutable array, in
1045 -- index order.
1046 getAssocs :: (MArray a e m, Ix i) => a i e -> m [(i, e)]
1047 getAssocs marr = case bounds marr of
1048     (l,u) -> sequence [do e <- unsafeRead marr (index (l,u) i); return (i,e)
1049               | i <- range (l,u)]
1050
1051 {-# INLINE mapArray #-}
1052 -- | Constructs a new array derived from the original array by applying a
1053 -- function to each of the elements.
1054 mapArray :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e)
1055 mapArray f marr = case bounds marr of
1056   (l,u) -> do
1057     marr' <- newArray_ (l,u)
1058     sequence_ [do
1059         e <- unsafeRead marr i
1060         unsafeWrite marr' i (f e)
1061         | i <- [0 .. rangeSize (l,u) - 1]]
1062     return marr'
1063
1064 {-# INLINE mapIndices #-}
1065 -- | Constructs a new array derived from the original array by applying a
1066 -- function to each of the indices.
1067 mapIndices :: (MArray a e m, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> m (a i e)
1068 mapIndices (l,u) f marr = do
1069     marr' <- newArray_ (l,u)
1070     sequence_ [do
1071         e <- readArray marr (f i)
1072         unsafeWrite marr' (unsafeIndex (l,u) i) e
1073         | i <- range (l,u)]
1074     return marr'
1075
1076 -----------------------------------------------------------------------------
1077 -- Polymorphic non-strict mutable arrays (ST monad)
1078
1079 instance HasBounds (STArray s) where
1080     {-# INLINE bounds #-}
1081     bounds = ArrST.boundsSTArray
1082
1083 instance MArray (STArray s) e (ST s) where
1084     {-# INLINE newArray #-}
1085     newArray    = ArrST.newSTArray
1086     {-# INLINE unsafeRead #-}
1087     unsafeRead  = ArrST.unsafeReadSTArray
1088     {-# INLINE unsafeWrite #-}
1089     unsafeWrite = ArrST.unsafeWriteSTArray
1090
1091 instance MArray (STArray s) e (Lazy.ST s) where
1092     {-# INLINE newArray #-}
1093     newArray (l,u) e    = strictToLazyST (ArrST.newSTArray (l,u) e)
1094     {-# INLINE unsafeRead #-}
1095     unsafeRead arr i    = strictToLazyST (ArrST.unsafeReadSTArray arr i)
1096     {-# INLINE unsafeWrite #-}
1097     unsafeWrite arr i e = strictToLazyST (ArrST.unsafeWriteSTArray arr i e)
1098
1099 #ifdef __HUGS__
1100 INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray")
1101 #endif
1102
1103 -----------------------------------------------------------------------------
1104 -- Flat unboxed mutable arrays (ST monad)
1105
1106 -- | A mutable array with unboxed elements, that can be manipulated in
1107 -- the 'ST' monad.  The type arguments are as follows:
1108 --
1109 --  * @s@: the state variable argument for the 'ST' type
1110 --
1111 --  * @i@: the index type of the array (should be an instance of @Ix@)
1112 --
1113 --  * @e@: the element type of the array.  Only certain element types
1114 --    are supported.
1115 --
1116 -- An 'STUArray' will generally be more efficient (in terms of both time
1117 -- and space) than the equivalent boxed version ('STArray') with the same
1118 -- element type.  However, 'STUArray' is strict in its elements - so
1119 -- don\'t use 'STUArray' if you require the non-strictness that
1120 -- 'STArray' provides.
1121 #ifdef __GLASGOW_HASKELL__
1122 data STUArray s i a = STUArray !i !i (MutableByteArray# s)
1123 #endif
1124 #ifdef __HUGS__
1125 data STUArray s i a = STUArray !i !i !(MutableByteArray s)
1126 #endif
1127
1128 INSTANCE_TYPEABLE3(STUArray,stUArrayTc,"STUArray")
1129
1130 instance HasBounds (STUArray s) where
1131     {-# INLINE bounds #-}
1132     bounds (STUArray l u _) = (l,u)
1133
1134 #ifdef __GLASGOW_HASKELL__
1135 instance MArray (STUArray s) Bool (ST s) where
1136     {-# INLINE newArray #-}
1137     newArray (l,u) init = ST $ \s1# ->
1138         case rangeSize (l,u)            of { I# n# ->
1139         case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
1140         case bOOL_WORD_SCALE n#         of { n'# ->
1141         let loop i# s3# | i# ==# n'# = s3#
1142                         | otherwise  =
1143                 case writeWordArray# marr# i# e# s3# of { s4# ->
1144                 loop (i# +# 1#) s4# } in
1145         case loop 0# s2#                of { s3# ->
1146         (# s3#, STUArray l u marr# #) }}}}
1147       where
1148         W# e# = if init then maxBound else 0
1149     {-# INLINE newArray_ #-}
1150     newArray_ (l,u) = ST $ \s1# ->
1151         case rangeSize (l,u)            of { I# n# ->
1152         case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
1153         (# s2#, STUArray l u marr# #) }}
1154     {-# INLINE unsafeRead #-}
1155     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1156         case readWordArray# marr# (bOOL_INDEX i#) s1# of { (# s2#, e# #) ->
1157         (# s2#, (e# `and#` bOOL_BIT i#) `neWord#` int2Word# 0# #) }
1158     {-# INLINE unsafeWrite #-}
1159     unsafeWrite (STUArray _ _ marr#) (I# i#) e = ST $ \s1# ->
1160         case bOOL_INDEX i#              of { j# ->
1161         case readWordArray# marr# j# s1# of { (# s2#, old# #) ->
1162         case if e then old# `or#` bOOL_BIT i#
1163              else old# `and#` bOOL_NOT_BIT i# of { e# ->
1164         case writeWordArray# marr# j# e# s2# of { s3# ->
1165         (# s3#, () #) }}}}
1166
1167 instance MArray (STUArray s) Char (ST s) where
1168     {-# INLINE newArray_ #-}
1169     newArray_ (l,u) = ST $ \s1# ->
1170         case rangeSize (l,u)            of { I# n# ->
1171         case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
1172         (# s2#, STUArray l u marr# #) }}
1173     {-# INLINE unsafeRead #-}
1174     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1175         case readWideCharArray# marr# i# s1# of { (# s2#, e# #) ->
1176         (# s2#, C# e# #) }
1177     {-# INLINE unsafeWrite #-}
1178     unsafeWrite (STUArray _ _ marr#) (I# i#) (C# e#) = ST $ \s1# ->
1179         case writeWideCharArray# marr# i# e# s1# of { s2# ->
1180         (# s2#, () #) }
1181
1182 instance MArray (STUArray s) Int (ST s) where
1183     {-# INLINE newArray_ #-}
1184     newArray_ (l,u) = ST $ \s1# ->
1185         case rangeSize (l,u)            of { I# n# ->
1186         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1187         (# s2#, STUArray l u marr# #) }}
1188     {-# INLINE unsafeRead #-}
1189     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1190         case readIntArray# marr# i# s1# of { (# s2#, e# #) ->
1191         (# s2#, I# e# #) }
1192     {-# INLINE unsafeWrite #-}
1193     unsafeWrite (STUArray _ _ marr#) (I# i#) (I# e#) = ST $ \s1# ->
1194         case writeIntArray# marr# i# e# s1# of { s2# ->
1195         (# s2#, () #) }
1196
1197 instance MArray (STUArray s) Word (ST s) where
1198     {-# INLINE newArray_ #-}
1199     newArray_ (l,u) = ST $ \s1# ->
1200         case rangeSize (l,u)            of { I# n# ->
1201         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1202         (# s2#, STUArray l u marr# #) }}
1203     {-# INLINE unsafeRead #-}
1204     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1205         case readWordArray# marr# i# s1# of { (# s2#, e# #) ->
1206         (# s2#, W# e# #) }
1207     {-# INLINE unsafeWrite #-}
1208     unsafeWrite (STUArray _ _ marr#) (I# i#) (W# e#) = ST $ \s1# ->
1209         case writeWordArray# marr# i# e# s1# of { s2# ->
1210         (# s2#, () #) }
1211
1212 instance MArray (STUArray s) (Ptr a) (ST s) where
1213     {-# INLINE newArray_ #-}
1214     newArray_ (l,u) = ST $ \s1# ->
1215         case rangeSize (l,u)            of { I# n# ->
1216         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1217         (# s2#, STUArray l u marr# #) }}
1218     {-# INLINE unsafeRead #-}
1219     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1220         case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
1221         (# s2#, Ptr e# #) }
1222     {-# INLINE unsafeWrite #-}
1223     unsafeWrite (STUArray _ _ marr#) (I# i#) (Ptr e#) = ST $ \s1# ->
1224         case writeAddrArray# marr# i# e# s1# of { s2# ->
1225         (# s2#, () #) }
1226
1227 instance MArray (STUArray s) (FunPtr a) (ST s) where
1228     {-# INLINE newArray_ #-}
1229     newArray_ (l,u) = ST $ \s1# ->
1230         case rangeSize (l,u)            of { I# n# ->
1231         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1232         (# s2#, STUArray l u marr# #) }}
1233     {-# INLINE unsafeRead #-}
1234     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1235         case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
1236         (# s2#, FunPtr e# #) }
1237     {-# INLINE unsafeWrite #-}
1238     unsafeWrite (STUArray _ _ marr#) (I# i#) (FunPtr e#) = ST $ \s1# ->
1239         case writeAddrArray# marr# i# e# s1# of { s2# ->
1240         (# s2#, () #) }
1241
1242 instance MArray (STUArray s) Float (ST s) where
1243     {-# INLINE newArray_ #-}
1244     newArray_ (l,u) = ST $ \s1# ->
1245         case rangeSize (l,u)            of { I# n# ->
1246         case newByteArray# (fLOAT_SCALE n#) s1# of { (# s2#, marr# #) ->
1247         (# s2#, STUArray l u marr# #) }}
1248     {-# INLINE unsafeRead #-}
1249     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1250         case readFloatArray# marr# i# s1# of { (# s2#, e# #) ->
1251         (# s2#, F# e# #) }
1252     {-# INLINE unsafeWrite #-}
1253     unsafeWrite (STUArray _ _ marr#) (I# i#) (F# e#) = ST $ \s1# ->
1254         case writeFloatArray# marr# i# e# s1# of { s2# ->
1255         (# s2#, () #) }
1256
1257 instance MArray (STUArray s) Double (ST s) where
1258     {-# INLINE newArray_ #-}
1259     newArray_ (l,u) = ST $ \s1# ->
1260         case rangeSize (l,u)            of { I# n# ->
1261         case newByteArray# (dOUBLE_SCALE n#) s1# of { (# s2#, marr# #) ->
1262         (# s2#, STUArray l u marr# #) }}
1263     {-# INLINE unsafeRead #-}
1264     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1265         case readDoubleArray# marr# i# s1# of { (# s2#, e# #) ->
1266         (# s2#, D# e# #) }
1267     {-# INLINE unsafeWrite #-}
1268     unsafeWrite (STUArray _ _ marr#) (I# i#) (D# e#) = ST $ \s1# ->
1269         case writeDoubleArray# marr# i# e# s1# of { s2# ->
1270         (# s2#, () #) }
1271
1272 instance MArray (STUArray s) (StablePtr a) (ST s) where
1273     {-# INLINE newArray_ #-}
1274     newArray_ (l,u) = ST $ \s1# ->
1275         case rangeSize (l,u)            of { I# n# ->
1276         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
1277         (# s2#, STUArray l u marr# #) }}
1278     {-# INLINE unsafeRead #-}
1279     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1280         case readStablePtrArray# marr# i# s1# of { (# s2#, e# #) ->
1281         (# s2# , StablePtr e# #) }
1282     {-# INLINE unsafeWrite #-}
1283     unsafeWrite (STUArray _ _ marr#) (I# i#) (StablePtr e#) = ST $ \s1# ->
1284         case writeStablePtrArray# marr# i# e# s1# of { s2# ->
1285         (# s2#, () #) }
1286
1287 instance MArray (STUArray s) Int8 (ST s) where
1288     {-# INLINE newArray_ #-}
1289     newArray_ (l,u) = ST $ \s1# ->
1290         case rangeSize (l,u)            of { I# n# ->
1291         case newByteArray# n# s1#       of { (# s2#, marr# #) ->
1292         (# s2#, STUArray l u marr# #) }}
1293     {-# INLINE unsafeRead #-}
1294     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1295         case readInt8Array# marr# i# s1# of { (# s2#, e# #) ->
1296         (# s2#, I8# e# #) }
1297     {-# INLINE unsafeWrite #-}
1298     unsafeWrite (STUArray _ _ marr#) (I# i#) (I8# e#) = ST $ \s1# ->
1299         case writeInt8Array# marr# i# e# s1# of { s2# ->
1300         (# s2#, () #) }
1301
1302 instance MArray (STUArray s) Int16 (ST s) where
1303     {-# INLINE newArray_ #-}
1304     newArray_ (l,u) = ST $ \s1# ->
1305         case rangeSize (l,u)            of { I# n# ->
1306         case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) ->
1307         (# s2#, STUArray l u marr# #) }}
1308     {-# INLINE unsafeRead #-}
1309     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1310         case readInt16Array# marr# i# s1# of { (# s2#, e# #) ->
1311         (# s2#, I16# e# #) }
1312     {-# INLINE unsafeWrite #-}
1313     unsafeWrite (STUArray _ _ marr#) (I# i#) (I16# e#) = ST $ \s1# ->
1314         case writeInt16Array# marr# i# e# s1# of { s2# ->
1315         (# s2#, () #) }
1316
1317 instance MArray (STUArray s) Int32 (ST s) where
1318     {-# INLINE newArray_ #-}
1319     newArray_ (l,u) = ST $ \s1# ->
1320         case rangeSize (l,u)            of { I# n# ->
1321         case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
1322         (# s2#, STUArray l u marr# #) }}
1323     {-# INLINE unsafeRead #-}
1324     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1325         case readInt32Array# marr# i# s1# of { (# s2#, e# #) ->
1326         (# s2#, I32# e# #) }
1327     {-# INLINE unsafeWrite #-}
1328     unsafeWrite (STUArray _ _ marr#) (I# i#) (I32# e#) = ST $ \s1# ->
1329         case writeInt32Array# marr# i# e# s1# of { s2# ->
1330         (# s2#, () #) }
1331
1332 instance MArray (STUArray s) Int64 (ST s) where
1333     {-# INLINE newArray_ #-}
1334     newArray_ (l,u) = ST $ \s1# ->
1335         case rangeSize (l,u)            of { I# n# ->
1336         case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) ->
1337         (# s2#, STUArray l u marr# #) }}
1338     {-# INLINE unsafeRead #-}
1339     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1340         case readInt64Array# marr# i# s1# of { (# s2#, e# #) ->
1341         (# s2#, I64# e# #) }
1342     {-# INLINE unsafeWrite #-}
1343     unsafeWrite (STUArray _ _ marr#) (I# i#) (I64# e#) = ST $ \s1# ->
1344         case writeInt64Array# marr# i# e# s1# of { s2# ->
1345         (# s2#, () #) }
1346
1347 instance MArray (STUArray s) Word8 (ST s) where
1348     {-# INLINE newArray_ #-}
1349     newArray_ (l,u) = ST $ \s1# ->
1350         case rangeSize (l,u)            of { I# n# ->
1351         case newByteArray# n# s1#       of { (# s2#, marr# #) ->
1352         (# s2#, STUArray l u marr# #) }}
1353     {-# INLINE unsafeRead #-}
1354     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1355         case readWord8Array# marr# i# s1# of { (# s2#, e# #) ->
1356         (# s2#, W8# e# #) }
1357     {-# INLINE unsafeWrite #-}
1358     unsafeWrite (STUArray _ _ marr#) (I# i#) (W8# e#) = ST $ \s1# ->
1359         case writeWord8Array# marr# i# e# s1# of { s2# ->
1360         (# s2#, () #) }
1361
1362 instance MArray (STUArray s) Word16 (ST s) where
1363     {-# INLINE newArray_ #-}
1364     newArray_ (l,u) = ST $ \s1# ->
1365         case rangeSize (l,u)            of { I# n# ->
1366         case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) ->
1367         (# s2#, STUArray l u marr# #) }}
1368     {-# INLINE unsafeRead #-}
1369     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1370         case readWord16Array# marr# i# s1# of { (# s2#, e# #) ->
1371         (# s2#, W16# e# #) }
1372     {-# INLINE unsafeWrite #-}
1373     unsafeWrite (STUArray _ _ marr#) (I# i#) (W16# e#) = ST $ \s1# ->
1374         case writeWord16Array# marr# i# e# s1# of { s2# ->
1375         (# s2#, () #) }
1376
1377 instance MArray (STUArray s) Word32 (ST s) where
1378     {-# INLINE newArray_ #-}
1379     newArray_ (l,u) = ST $ \s1# ->
1380         case rangeSize (l,u)            of { I# n# ->
1381         case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
1382         (# s2#, STUArray l u marr# #) }}
1383     {-# INLINE unsafeRead #-}
1384     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1385         case readWord32Array# marr# i# s1# of { (# s2#, e# #) ->
1386         (# s2#, W32# e# #) }
1387     {-# INLINE unsafeWrite #-}
1388     unsafeWrite (STUArray _ _ marr#) (I# i#) (W32# e#) = ST $ \s1# ->
1389         case writeWord32Array# marr# i# e# s1# of { s2# ->
1390         (# s2#, () #) }
1391
1392 instance MArray (STUArray s) Word64 (ST s) where
1393     {-# INLINE newArray_ #-}
1394     newArray_ (l,u) = ST $ \s1# ->
1395         case rangeSize (l,u)            of { I# n# ->
1396         case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) ->
1397         (# s2#, STUArray l u marr# #) }}
1398     {-# INLINE unsafeRead #-}
1399     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1400         case readWord64Array# marr# i# s1# of { (# s2#, e# #) ->
1401         (# s2#, W64# e# #) }
1402     {-# INLINE unsafeWrite #-}
1403     unsafeWrite (STUArray _ _ marr#) (I# i#) (W64# e#) = ST $ \s1# ->
1404         case writeWord64Array# marr# i# e# s1# of { s2# ->
1405         (# s2#, () #) }
1406
1407 -----------------------------------------------------------------------------
1408 -- Translation between elements and bytes
1409
1410 bOOL_SCALE, bOOL_WORD_SCALE,
1411   wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int#
1412 bOOL_SCALE n# = (n# +# last#) `uncheckedIShiftRA#` 3#
1413   where I# last# = SIZEOF_HSWORD * 8 - 1
1414 bOOL_WORD_SCALE n# = bOOL_INDEX (n# +# last#)
1415   where I# last# = SIZEOF_HSWORD * 8 - 1
1416 wORD_SCALE   n# = scale# *# n# where I# scale# = SIZEOF_HSWORD
1417 dOUBLE_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSDOUBLE
1418 fLOAT_SCALE  n# = scale# *# n# where I# scale# = SIZEOF_HSFLOAT
1419
1420 bOOL_INDEX :: Int# -> Int#
1421 #if SIZEOF_HSWORD == 4
1422 bOOL_INDEX i# = i# `uncheckedIShiftRA#` 5#
1423 #elif SIZEOF_HSWORD == 8
1424 bOOL_INDEX i# = i# `uncheckedIShiftRA#` 6#
1425 #endif
1426
1427 bOOL_BIT, bOOL_NOT_BIT :: Int# -> Word#
1428 bOOL_BIT     n# = int2Word# 1# `uncheckedShiftL#` (word2Int# (int2Word# n# `and#` mask#))
1429   where W# mask# = SIZEOF_HSWORD * 8 - 1
1430 bOOL_NOT_BIT n# = bOOL_BIT n# `xor#` mb# where W# mb# = maxBound
1431 #endif /* __GLASGOW_HASKELL__ */
1432
1433 #ifdef __HUGS__
1434 newMBArray_ :: (Ix i, Storable e) => (i,i) -> ST s (STUArray s i e)
1435 newMBArray_ = makeArray undefined
1436   where
1437     makeArray :: (Ix i, Storable e) => e -> (i,i) -> ST s (STUArray s i e)
1438     makeArray dummy (l,u) = do
1439         marr <- newMutableByteArray (rangeSize (l,u) * sizeOf dummy)
1440         return (STUArray l u marr)
1441
1442 unsafeReadMBArray :: Storable e => STUArray s i e -> Int -> ST s e
1443 unsafeReadMBArray (STUArray _ _ marr) = readMutableByteArray marr
1444
1445 unsafeWriteMBArray :: Storable e => STUArray s i e -> Int -> e -> ST s ()
1446 unsafeWriteMBArray (STUArray _ _ marr) = writeMutableByteArray marr
1447
1448 instance MArray (STUArray s) Bool (ST s) where
1449     newArray_ (l,u) = do
1450         marr <- newMutableByteArray (bOOL_SCALE (rangeSize (l,u)))
1451         return (STUArray l u marr)
1452     unsafeRead (STUArray _ _ marr) i = do
1453         let ix = bOOL_INDEX i
1454             bit = bOOL_SUBINDEX i
1455         w <- readMutableByteArray marr ix
1456         return (testBit (w::BitSet) bit)
1457     unsafeWrite (STUArray _ _ marr) i e = do
1458         let ix = bOOL_INDEX i
1459             bit = bOOL_SUBINDEX i
1460         w <- readMutableByteArray marr ix
1461         writeMutableByteArray marr ix
1462             (if e then setBit (w::BitSet) bit else clearBit w bit)
1463
1464 instance MArray (STUArray s) Char (ST s) where
1465     newArray_ = newMBArray_
1466     unsafeRead = unsafeReadMBArray
1467     unsafeWrite = unsafeWriteMBArray
1468
1469 instance MArray (STUArray s) Int (ST s) where
1470     newArray_ = newMBArray_
1471     unsafeRead = unsafeReadMBArray
1472     unsafeWrite = unsafeWriteMBArray
1473
1474 instance MArray (STUArray s) Word (ST s) where
1475     newArray_ = newMBArray_
1476     unsafeRead = unsafeReadMBArray
1477     unsafeWrite = unsafeWriteMBArray
1478
1479 instance MArray (STUArray s) (Ptr a) (ST s) where
1480     newArray_ = newMBArray_
1481     unsafeRead = unsafeReadMBArray
1482     unsafeWrite = unsafeWriteMBArray
1483
1484 instance MArray (STUArray s) (FunPtr a) (ST s) where
1485     newArray_ = newMBArray_
1486     unsafeRead = unsafeReadMBArray
1487     unsafeWrite = unsafeWriteMBArray
1488
1489 instance MArray (STUArray s) Float (ST s) where
1490     newArray_ = newMBArray_
1491     unsafeRead = unsafeReadMBArray
1492     unsafeWrite = unsafeWriteMBArray
1493
1494 instance MArray (STUArray s) Double (ST s) where
1495     newArray_ = newMBArray_
1496     unsafeRead = unsafeReadMBArray
1497     unsafeWrite = unsafeWriteMBArray
1498
1499 instance MArray (STUArray s) (StablePtr a) (ST s) where
1500     newArray_ = newMBArray_
1501     unsafeRead = unsafeReadMBArray
1502     unsafeWrite = unsafeWriteMBArray
1503
1504 instance MArray (STUArray s) Int8 (ST s) where
1505     newArray_ = newMBArray_
1506     unsafeRead = unsafeReadMBArray
1507     unsafeWrite = unsafeWriteMBArray
1508
1509 instance MArray (STUArray s) Int16 (ST s) where
1510     newArray_ = newMBArray_
1511     unsafeRead = unsafeReadMBArray
1512     unsafeWrite = unsafeWriteMBArray
1513
1514 instance MArray (STUArray s) Int32 (ST s) where
1515     newArray_ = newMBArray_
1516     unsafeRead = unsafeReadMBArray
1517     unsafeWrite = unsafeWriteMBArray
1518
1519 instance MArray (STUArray s) Int64 (ST s) where
1520     newArray_ = newMBArray_
1521     unsafeRead = unsafeReadMBArray
1522     unsafeWrite = unsafeWriteMBArray
1523
1524 instance MArray (STUArray s) Word8 (ST s) where
1525     newArray_ = newMBArray_
1526     unsafeRead = unsafeReadMBArray
1527     unsafeWrite = unsafeWriteMBArray
1528
1529 instance MArray (STUArray s) Word16 (ST s) where
1530     newArray_ = newMBArray_
1531     unsafeRead = unsafeReadMBArray
1532     unsafeWrite = unsafeWriteMBArray
1533
1534 instance MArray (STUArray s) Word32 (ST s) where
1535     newArray_ = newMBArray_
1536     unsafeRead = unsafeReadMBArray
1537     unsafeWrite = unsafeWriteMBArray
1538
1539 instance MArray (STUArray s) Word64 (ST s) where
1540     newArray_ = newMBArray_
1541     unsafeRead = unsafeReadMBArray
1542     unsafeWrite = unsafeWriteMBArray
1543
1544 type BitSet = Word8
1545
1546 bitSetSize = bitSize (0::BitSet)
1547
1548 bOOL_SCALE :: Int -> Int
1549 bOOL_SCALE n = (n + bitSetSize - 1) `div` bitSetSize
1550
1551 bOOL_INDEX :: Int -> Int
1552 bOOL_INDEX i = i `div` bitSetSize
1553
1554 bOOL_SUBINDEX :: Int -> Int
1555 bOOL_SUBINDEX i = i `mod` bitSetSize
1556 #endif /* __HUGS__ */
1557
1558 -----------------------------------------------------------------------------
1559 -- Freezing
1560
1561 -- | Converts a mutable array (any instance of 'MArray') to an
1562 -- immutable array (any instance of 'IArray') by taking a complete
1563 -- copy of it.
1564 freeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
1565 freeze marr = case bounds marr of
1566   (l,u) -> do
1567     ies <- sequence [do e <- unsafeRead marr i; return (i,e)
1568                      | i <- [0 .. rangeSize (l,u) - 1]]
1569     return (unsafeArray (l,u) ies)
1570
1571 #ifdef __GLASGOW_HASKELL__
1572 freezeSTUArray :: Ix i => STUArray s i e -> ST s (UArray i e)
1573 freezeSTUArray (STUArray l u marr#) = ST $ \s1# ->
1574     case sizeofMutableByteArray# marr#  of { n# ->
1575     case newByteArray# n# s1#           of { (# s2#, marr'# #) ->
1576     case unsafeCoerce# memcpy marr'# marr# n# s2# of { (# s3#, () #) ->
1577     case unsafeFreezeByteArray# marr'# s3# of { (# s4#, arr# #) ->
1578     (# s4#, UArray l u arr# #) }}}}
1579
1580 {-# RULES
1581 "freeze/STArray"  freeze = ArrST.freezeSTArray
1582 "freeze/STUArray" freeze = freezeSTUArray
1583     #-}
1584 #endif /* __GLASGOW_HASKELL__ */
1585
1586 -- In-place conversion of mutable arrays to immutable ones places
1587 -- a proof obligation on the user: no other parts of your code can
1588 -- have a reference to the array at the point where you unsafely
1589 -- freeze it (and, subsequently mutate it, I suspect).
1590
1591 {- |
1592    Converts an mutable array into an immutable array.  The
1593    implementation may either simply cast the array from
1594    one type to the other without copying the array, or it
1595    may take a full copy of the array.
1596
1597    Note that because the array is possibly not copied, any subsequent
1598    modifications made to the mutable version of the array may be
1599    shared with the immutable version.  It is safe to use, therefore, if
1600    the mutable version is never modified after the freeze operation.
1601
1602    The non-copying implementation is supported between certain pairs
1603    of array types only; one constraint is that the array types must
1604    have identical representations.  In GHC, The following pairs of
1605    array types have a non-copying O(1) implementation of
1606    'unsafeFreeze'.  Because the optimised versions are enabled by
1607    specialisations, you will need to compile with optimisation (-O) to
1608    get them.
1609
1610      * 'Data.Array.IO.IOUArray' -> 'Data.Array.Unboxed.UArray'
1611
1612      * 'Data.Array.ST.STUArray' -> 'Data.Array.Unboxed.UArray'
1613
1614      * 'Data.Array.IO.IOArray' -> 'Data.Array.Array'
1615
1616      * 'Data.Array.ST.STArray' -> 'Data.Array.Array'
1617 -}
1618 {-# INLINE unsafeFreeze #-}
1619 unsafeFreeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
1620 unsafeFreeze = freeze
1621
1622 {-# RULES
1623 "unsafeFreeze/STArray"  unsafeFreeze = ArrST.unsafeFreezeSTArray
1624 "unsafeFreeze/STUArray" unsafeFreeze = unsafeFreezeSTUArray
1625     #-}
1626
1627 -----------------------------------------------------------------------------
1628 -- Thawing
1629
1630 -- | Converts an immutable array (any instance of 'IArray') into a
1631 -- mutable array (any instance of 'MArray') by taking a complete copy
1632 -- of it.
1633 thaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
1634 thaw arr = case bounds arr of
1635   (l,u) -> do
1636     marr <- newArray_ (l,u)
1637     sequence_ [unsafeWrite marr i (unsafeAt arr i)
1638                | i <- [0 .. rangeSize (l,u) - 1]]
1639     return marr
1640
1641 #ifdef __GLASGOW_HASKELL__
1642 thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1643 thawSTUArray (UArray l u arr#) = ST $ \s1# ->
1644     case sizeofByteArray# arr#          of { n# ->
1645     case newByteArray# n# s1#           of { (# s2#, marr# #) ->
1646     case unsafeCoerce# memcpy marr# arr# n# s2# of { (# s3#, () #) ->
1647     (# s3#, STUArray l u marr# #) }}}
1648
1649 foreign import ccall unsafe "memcpy"
1650     memcpy :: MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO ()
1651
1652 {-# RULES
1653 "thaw/STArray"  thaw = ArrST.thawSTArray
1654 "thaw/STUArray" thaw = thawSTUArray
1655     #-}
1656 #endif /* __GLASGOW_HASKELL__ */
1657
1658 #ifdef __HUGS__
1659 thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1660 thawSTUArray (UArray l u arr) = do
1661     marr <- thawByteArray arr
1662     return (STUArray l u marr)
1663 #endif
1664
1665 -- In-place conversion of immutable arrays to mutable ones places
1666 -- a proof obligation on the user: no other parts of your code can
1667 -- have a reference to the array at the point where you unsafely
1668 -- thaw it (and, subsequently mutate it, I suspect).
1669
1670 {- |
1671    Converts an immutable array into a mutable array.  The
1672    implementation may either simply cast the array from
1673    one type to the other without copying the array, or it
1674    may take a full copy of the array.
1675
1676    Note that because the array is possibly not copied, any subsequent
1677    modifications made to the mutable version of the array may be
1678    shared with the immutable version.  It is only safe to use,
1679    therefore, if the immutable array is never referenced again in this
1680    thread, and there is no possibility that it can be also referenced
1681    in another thread.  If you use an unsafeThaw/write/unsafeFreeze
1682    sequence in a multi-threaded setting, then you must ensure that
1683    this sequence is atomic with respect to other threads, or a garbage
1684    collector crash may result (because the write may be writing to a
1685    frozen array).
1686
1687    The non-copying implementation is supported between certain pairs
1688    of array types only; one constraint is that the array types must
1689    have identical representations.  In GHC, The following pairs of
1690    array types have a non-copying O(1) implementation of
1691    'unsafeThaw'.  Because the optimised versions are enabled by
1692    specialisations, you will need to compile with optimisation (-O) to
1693    get them.
1694
1695      * 'Data.Array.Unboxed.UArray' -> 'Data.Array.IO.IOUArray'
1696
1697      * 'Data.Array.Unboxed.UArray' -> 'Data.Array.ST.STUArray'
1698
1699      * 'Data.Array.Array'  -> 'Data.Array.IO.IOArray'
1700
1701      * 'Data.Array.Array'  -> 'Data.Array.ST.STArray'
1702 -}
1703 {-# INLINE unsafeThaw #-}
1704 unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
1705 unsafeThaw = thaw
1706
1707 #ifdef __GLASGOW_HASKELL__
1708 {-# INLINE unsafeThawSTUArray #-}
1709 unsafeThawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1710 unsafeThawSTUArray (UArray l u marr#) =
1711     return (STUArray l u (unsafeCoerce# marr#))
1712
1713 {-# RULES
1714 "unsafeThaw/STArray"    unsafeThaw = ArrST.unsafeThawSTArray
1715 "unsafeThaw/STUArray"   unsafeThaw = unsafeThawSTUArray
1716     #-}
1717 #endif /* __GLASGOW_HASKELL__ */
1718
1719 -- | Casts an 'STUArray' with one element type into one with a
1720 -- different element type.  All the elements of the resulting array
1721 -- are undefined (unless you know what you\'re doing...).
1722
1723 #ifdef __GLASGOW_HASKELL__
1724 castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
1725 castSTUArray (STUArray l u marr#) = return (STUArray l u marr#)
1726 #endif
1727
1728 #ifdef __HUGS__
1729 castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
1730 castSTUArray (STUArray l u marr) = return (STUArray l u marr)
1731 #endif