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