Data/Array/Base.hs

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