Data/Array/Base.hs

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