Data/Array/Base.hs

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