Data/Array/Base.hs

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