Data/Array/Base.hs

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