Data/Array/Base.hs

   1 {-# OPTIONS -monly-3-regs #-}
   2 -----------------------------------------------------------------------------
   3 --
   4 -- Module      :  Data.Array.Base
   5 -- Copyright   :  (c) The University of Glasgow 2001
   6 -- License     :  BSD-style (see the file libraries/core/LICENSE)
   7 --
   8 -- Maintainer  :  libraries@haskell.org
   9 -- Stability   :  experimental
  10 -- Portability :  non-portable
  11 --
  12 -- $Id: Base.hs,v 1.2 2001/07/31 13:28:58 simonmar Exp $
  13 --
  14 -- Basis for IArray and MArray.  Not intended for external consumption;
  15 -- use IArray or MArray instead.
  16 --
  17 -----------------------------------------------------------------------------
  18
  19 module Data.Array.Base where
  20
  21 import Prelude
  22
  23 import Data.Ix          ( Ix, range, index, rangeSize )
  24
  25 #ifdef __GLASGOW_HASKELL__
  26 import GHC.Arr          ( STArray, unsafeIndex )
  27 import qualified GHC.Arr
  28 import GHC.ST           ( ST(..), runST )
  29 import GHC.Base
  30 import GHC.Word         ( Word(..) )
  31 import GHC.Ptr          ( Ptr(..), FunPtr(..) )
  32 import GHC.Float        ( Float(..), Double(..) )
  33 import GHC.Stable       ( StablePtr(..) )
  34 import GHC.Int          ( Int8(..),  Int16(..),  Int32(..),  Int64(..) )
  35 import GHC.Word         ( Word8(..), Word16(..), Word32(..), Word64(..) )
  36 #endif
  37
  38 import Data.Dynamic
  39 #include "Dynamic.h"
  40
  41 -----------------------------------------------------------------------------
  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 showsUArray :: (IArray UArray e, Ix i, Show i, Show e)
 321             => Int -> UArray i e -> ShowS
 322 showsUArray p a =
 323     showParen (p > 9) $
 324     showString "array " .
 325     shows (bounds a) .
 326     showChar ' ' .
 327     shows (assocs a)
 328
 329 -----------------------------------------------------------------------------
 330 -- Flat unboxed arrays: instances
 331
 332 instance IArray UArray Bool where
 333     {-# INLINE unsafeArray #-}
 334     unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
 335     {-# INLINE unsafeAt #-}
 336     unsafeAt (UArray _ _ arr#) (I# i#) =
 337         (indexWordArray# arr# (bOOL_INDEX i#) `and#` bOOL_BIT i#)
 338         `neWord#` int2Word# 0#
 339     {-# INLINE unsafeReplace #-}
 340     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 341     {-# INLINE unsafeAccum #-}
 342     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 343     {-# INLINE unsafeAccumArray #-}
 344     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 345
 346 instance IArray UArray Char where
 347     {-# INLINE unsafeArray #-}
 348     unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
 349     {-# INLINE unsafeAt #-}
 350     unsafeAt (UArray _ _ arr#) (I# i#) = C# (indexWideCharArray# arr# i#)
 351     {-# INLINE unsafeReplace #-}
 352     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 353     {-# INLINE unsafeAccum #-}
 354     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 355     {-# INLINE unsafeAccumArray #-}
 356     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 357
 358 instance IArray UArray Int where
 359     {-# INLINE unsafeArray #-}
 360     unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
 361     {-# INLINE unsafeAt #-}
 362     unsafeAt (UArray _ _ arr#) (I# i#) = I# (indexIntArray# arr# i#)
 363     {-# INLINE unsafeReplace #-}
 364     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 365     {-# INLINE unsafeAccum #-}
 366     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 367     {-# INLINE unsafeAccumArray #-}
 368     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 369
 370 instance IArray UArray Word where
 371     {-# INLINE unsafeArray #-}
 372     unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
 373     {-# INLINE unsafeAt #-}
 374     unsafeAt (UArray _ _ arr#) (I# i#) = W# (indexWordArray# arr# i#)
 375     {-# INLINE unsafeReplace #-}
 376     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 377     {-# INLINE unsafeAccum #-}
 378     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 379     {-# INLINE unsafeAccumArray #-}
 380     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 381
 382 instance IArray UArray (Ptr a) where
 383     {-# INLINE unsafeArray #-}
 384     unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
 385     {-# INLINE unsafeAt #-}
 386     unsafeAt (UArray _ _ arr#) (I# i#) = Ptr (indexAddrArray# arr# i#)
 387     {-# INLINE unsafeReplace #-}
 388     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 389     {-# INLINE unsafeAccum #-}
 390     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 391     {-# INLINE unsafeAccumArray #-}
 392     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 393
 394 instance IArray UArray (FunPtr a) where
 395     {-# INLINE unsafeArray #-}
 396     unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
 397     {-# INLINE unsafeAt #-}
 398     unsafeAt (UArray _ _ arr#) (I# i#) = FunPtr (indexAddrArray# arr# i#)
 399     {-# INLINE unsafeReplace #-}
 400     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 401     {-# INLINE unsafeAccum #-}
 402     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 403     {-# INLINE unsafeAccumArray #-}
 404     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 405
 406 instance IArray UArray Float where
 407     {-# INLINE unsafeArray #-}
 408     unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
 409     {-# INLINE unsafeAt #-}
 410     unsafeAt (UArray _ _ arr#) (I# i#) = F# (indexFloatArray# arr# i#)
 411     {-# INLINE unsafeReplace #-}
 412     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 413     {-# INLINE unsafeAccum #-}
 414     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 415     {-# INLINE unsafeAccumArray #-}
 416     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 417
 418 instance IArray UArray Double where
 419     {-# INLINE unsafeArray #-}
 420     unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
 421     {-# INLINE unsafeAt #-}
 422     unsafeAt (UArray _ _ arr#) (I# i#) = D# (indexDoubleArray# arr# i#)
 423     {-# INLINE unsafeReplace #-}
 424     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 425     {-# INLINE unsafeAccum #-}
 426     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 427     {-# INLINE unsafeAccumArray #-}
 428     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 429
 430 instance IArray UArray (StablePtr a) where
 431     {-# INLINE unsafeArray #-}
 432     unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
 433     {-# INLINE unsafeAt #-}
 434     unsafeAt (UArray _ _ arr#) (I# i#) = StablePtr (indexStablePtrArray# arr# i#)
 435     {-# INLINE unsafeReplace #-}
 436     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 437     {-# INLINE unsafeAccum #-}
 438     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 439     {-# INLINE unsafeAccumArray #-}
 440     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 441
 442 instance IArray UArray Int8 where
 443     {-# INLINE unsafeArray #-}
 444     unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
 445     {-# INLINE unsafeAt #-}
 446     unsafeAt (UArray _ _ arr#) (I# i#) = I8# (indexInt8Array# arr# i#)
 447     {-# INLINE unsafeReplace #-}
 448     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 449     {-# INLINE unsafeAccum #-}
 450     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 451     {-# INLINE unsafeAccumArray #-}
 452     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 453
 454 instance IArray UArray Int16 where
 455     {-# INLINE unsafeArray #-}
 456     unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
 457     {-# INLINE unsafeAt #-}
 458     unsafeAt (UArray _ _ arr#) (I# i#) = I16# (indexInt16Array# arr# i#)
 459     {-# INLINE unsafeReplace #-}
 460     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 461     {-# INLINE unsafeAccum #-}
 462     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 463     {-# INLINE unsafeAccumArray #-}
 464     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 465
 466 instance IArray UArray Int32 where
 467     {-# INLINE unsafeArray #-}
 468     unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
 469     {-# INLINE unsafeAt #-}
 470     unsafeAt (UArray _ _ arr#) (I# i#) = I32# (indexInt32Array# arr# i#)
 471     {-# INLINE unsafeReplace #-}
 472     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 473     {-# INLINE unsafeAccum #-}
 474     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 475     {-# INLINE unsafeAccumArray #-}
 476     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 477
 478 instance IArray UArray Int64 where
 479     {-# INLINE unsafeArray #-}
 480     unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
 481     {-# INLINE unsafeAt #-}
 482     unsafeAt (UArray _ _ arr#) (I# i#) = I64# (indexInt64Array# arr# i#)
 483     {-# INLINE unsafeReplace #-}
 484     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 485     {-# INLINE unsafeAccum #-}
 486     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 487     {-# INLINE unsafeAccumArray #-}
 488     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 489
 490 instance IArray UArray Word8 where
 491     {-# INLINE unsafeArray #-}
 492     unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
 493     {-# INLINE unsafeAt #-}
 494     unsafeAt (UArray _ _ arr#) (I# i#) = W8# (indexWord8Array# arr# i#)
 495     {-# INLINE unsafeReplace #-}
 496     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 497     {-# INLINE unsafeAccum #-}
 498     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 499     {-# INLINE unsafeAccumArray #-}
 500     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 501
 502 instance IArray UArray Word16 where
 503     {-# INLINE unsafeArray #-}
 504     unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
 505     {-# INLINE unsafeAt #-}
 506     unsafeAt (UArray _ _ arr#) (I# i#) = W16# (indexWord16Array# arr# i#)
 507     {-# INLINE unsafeReplace #-}
 508     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 509     {-# INLINE unsafeAccum #-}
 510     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 511     {-# INLINE unsafeAccumArray #-}
 512     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 513
 514 instance IArray UArray Word32 where
 515     {-# INLINE unsafeArray #-}
 516     unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
 517     {-# INLINE unsafeAt #-}
 518     unsafeAt (UArray _ _ arr#) (I# i#) = W32# (indexWord32Array# arr# i#)
 519     {-# INLINE unsafeReplace #-}
 520     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 521     {-# INLINE unsafeAccum #-}
 522     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 523     {-# INLINE unsafeAccumArray #-}
 524     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 525
 526 instance IArray UArray Word64 where
 527     {-# INLINE unsafeArray #-}
 528     unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
 529     {-# INLINE unsafeAt #-}
 530     unsafeAt (UArray _ _ arr#) (I# i#) = W64# (indexWord64Array# arr# i#)
 531     {-# INLINE unsafeReplace #-}
 532     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
 533     {-# INLINE unsafeAccum #-}
 534     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
 535     {-# INLINE unsafeAccumArray #-}
 536     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 537
 538 instance Ix ix => Eq (UArray ix Bool) where
 539     (==) = eqUArray
 540
 541 instance Ix ix => Eq (UArray ix Char) where
 542     (==) = eqUArray
 543
 544 instance Ix ix => Eq (UArray ix Int) where
 545     (==) = eqUArray
 546
 547 instance Ix ix => Eq (UArray ix Word) where
 548     (==) = eqUArray
 549
 550 instance Ix ix => Eq (UArray ix (Ptr a)) where
 551     (==) = eqUArray
 552
 553 instance Ix ix => Eq (UArray ix (FunPtr a)) where
 554     (==) = eqUArray
 555
 556 instance Ix ix => Eq (UArray ix Float) where
 557     (==) = eqUArray
 558
 559 instance Ix ix => Eq (UArray ix Double) where
 560     (==) = eqUArray
 561
 562 instance Ix ix => Eq (UArray ix (StablePtr a)) where
 563     (==) = eqUArray
 564
 565 instance Ix ix => Eq (UArray ix Int8) where
 566     (==) = eqUArray
 567
 568 instance Ix ix => Eq (UArray ix Int16) where
 569     (==) = eqUArray
 570
 571 instance Ix ix => Eq (UArray ix Int32) where
 572     (==) = eqUArray
 573
 574 instance Ix ix => Eq (UArray ix Int64) where
 575     (==) = eqUArray
 576
 577 instance Ix ix => Eq (UArray ix Word8) where
 578     (==) = eqUArray
 579
 580 instance Ix ix => Eq (UArray ix Word16) where
 581     (==) = eqUArray
 582
 583 instance Ix ix => Eq (UArray ix Word32) where
 584     (==) = eqUArray
 585
 586 instance Ix ix => Eq (UArray ix Word64) where
 587     (==) = eqUArray
 588
 589 instance Ix ix => Ord (UArray ix Bool) where
 590     compare = cmpUArray
 591
 592 instance Ix ix => Ord (UArray ix Char) where
 593     compare = cmpUArray
 594
 595 instance Ix ix => Ord (UArray ix Int) where
 596     compare = cmpUArray
 597
 598 instance Ix ix => Ord (UArray ix Word) where
 599     compare = cmpUArray
 600
 601 instance Ix ix => Ord (UArray ix (Ptr a)) where
 602     compare = cmpUArray
 603
 604 instance Ix ix => Ord (UArray ix (FunPtr a)) where
 605     compare = cmpUArray
 606
 607 instance Ix ix => Ord (UArray ix Float) where
 608     compare = cmpUArray
 609
 610 instance Ix ix => Ord (UArray ix Double) where
 611     compare = cmpUArray
 612
 613 instance Ix ix => Ord (UArray ix Int8) where
 614     compare = cmpUArray
 615
 616 instance Ix ix => Ord (UArray ix Int16) where
 617     compare = cmpUArray
 618
 619 instance Ix ix => Ord (UArray ix Int32) where
 620     compare = cmpUArray
 621
 622 instance Ix ix => Ord (UArray ix Int64) where
 623     compare = cmpUArray
 624
 625 instance Ix ix => Ord (UArray ix Word8) where
 626     compare = cmpUArray
 627
 628 instance Ix ix => Ord (UArray ix Word16) where
 629     compare = cmpUArray
 630
 631 instance Ix ix => Ord (UArray ix Word32) where
 632     compare = cmpUArray
 633
 634 instance Ix ix => Ord (UArray ix Word64) where
 635     compare = cmpUArray
 636
 637 instance (Ix ix, Show ix) => Show (UArray ix Bool) where
 638     showsPrec = showsUArray
 639
 640 instance (Ix ix, Show ix) => Show (UArray ix Char) where
 641     showsPrec = showsUArray
 642
 643 instance (Ix ix, Show ix) => Show (UArray ix Int) where
 644     showsPrec = showsUArray
 645
 646 instance (Ix ix, Show ix) => Show (UArray ix Word) where
 647     showsPrec = showsUArray
 648
 649 instance (Ix ix, Show ix) => Show (UArray ix Float) where
 650     showsPrec = showsUArray
 651
 652 instance (Ix ix, Show ix) => Show (UArray ix Double) where
 653     showsPrec = showsUArray
 654
 655 instance (Ix ix, Show ix) => Show (UArray ix Int8) where
 656     showsPrec = showsUArray
 657
 658 instance (Ix ix, Show ix) => Show (UArray ix Int16) where
 659     showsPrec = showsUArray
 660
 661 instance (Ix ix, Show ix) => Show (UArray ix Int32) where
 662     showsPrec = showsUArray
 663
 664 instance (Ix ix, Show ix) => Show (UArray ix Int64) where
 665     showsPrec = showsUArray
 666
 667 instance (Ix ix, Show ix) => Show (UArray ix Word8) where
 668     showsPrec = showsUArray
 669
 670 instance (Ix ix, Show ix) => Show (UArray ix Word16) where
 671     showsPrec = showsUArray
 672
 673 instance (Ix ix, Show ix) => Show (UArray ix Word32) where
 674     showsPrec = showsUArray
 675
 676 instance (Ix ix, Show ix) => Show (UArray ix Word64) where
 677     showsPrec = showsUArray
 678
 679 -----------------------------------------------------------------------------
 680 -- Mutable arrays
 681
 682 {-# NOINLINE arrEleBottom #-}
 683 arrEleBottom :: a
 684 arrEleBottom = error "MArray: undefined array element"
 685
 686 class (HasBounds a, Monad m) => MArray a e m where
 687     newArray    :: Ix i => (i,i) -> e -> m (a i e)
 688     newArray_   :: Ix i => (i,i) -> m (a i e)
 689     unsafeRead  :: Ix i => a i e -> Int -> m e
 690     unsafeWrite :: Ix i => a i e -> Int -> e -> m ()
 691
 692     newArray (l,u) init = do
 693         marr <- newArray_ (l,u)
 694         sequence_ [unsafeWrite marr i init | i <- [0 .. rangeSize (l,u) - 1]]
 695         return marr
 696
 697     newArray_ (l,u) = newArray (l,u) arrEleBottom
 698
 699     -- newArray takes an initialiser which all elements of
 700     -- the newly created array are initialised to.  newArray_ takes
 701     -- no initialiser, it is assumed that the array is initialised with
 702     -- "undefined" values.
 703
 704     -- why not omit newArray_?  Because in the unboxed array case we would
 705     -- like to omit the initialisation altogether if possible.  We can't do
 706     -- this for boxed arrays, because the elements must all have valid values
 707     -- at all times in case of garbage collection.
 708
 709     -- why not omit newArray?  Because in the boxed case, we can omit the
 710     -- default initialisation with undefined values if we *do* know the
 711     -- initial value and it is constant for all elements.
 712
 713 {-# INLINE newListArray #-}
 714 newListArray :: (MArray a e m, Ix i) => (i,i) -> [e] -> m (a i e)
 715 newListArray (l,u) es = do
 716     marr <- newArray_ (l,u)
 717     let n = rangeSize (l,u)
 718     let fillFromList i xs | i == n    = return ()
 719                           | otherwise = case xs of
 720             []   -> return ()
 721             y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys
 722     fillFromList 0 es
 723     return marr
 724
 725 {-# INLINE readArray #-}
 726 readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
 727 readArray marr i | (l,u) <- bounds marr =
 728     unsafeRead marr (index (l,u) i)
 729
 730 {-# INLINE writeArray #-}
 731 writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
 732 writeArray marr i e | (l,u) <- bounds marr =
 733     unsafeWrite marr (index (l,u) i) e
 734
 735 {-# INLINE getElems #-}
 736 getElems :: (MArray a e m, Ix i) => a i e -> m [e]
 737 getElems marr | (l,u) <- bounds marr =
 738     sequence [unsafeRead marr i | i <- [0 .. rangeSize (l,u) - 1]]
 739
 740 {-# INLINE getAssocs #-}
 741 getAssocs :: (MArray a e m, Ix i) => a i e -> m [(i, e)]
 742 getAssocs marr | (l,u) <- bounds marr =
 743     sequence [do e <- unsafeRead marr (index (l,u) i); return (i,e)
 744               | i <- range (l,u)]
 745
 746 {-# INLINE mapArray #-}
 747 mapArray :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e)
 748 mapArray f marr | (l,u) <- bounds marr = do
 749     marr' <- newArray_ (l,u)
 750     sequence_ [do
 751         e <- unsafeRead marr i
 752         unsafeWrite marr' i (f e)
 753         | i <- [0 .. rangeSize (l,u) - 1]]
 754     return marr'
 755
 756 {-# INLINE mapIndices #-}
 757 mapIndices :: (MArray a e m, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> m (a i e)
 758 mapIndices (l,u) f marr = do
 759     marr' <- newArray_ (l,u)
 760     sequence_ [do
 761         e <- readArray marr (f i)
 762         unsafeWrite marr' (unsafeIndex (l,u) i) e
 763         | i <- range (l,u)]
 764     return marr'
 765
 766 -----------------------------------------------------------------------------
 767 -- Polymorphic non-strict mutable arrays (ST monad)
 768
 769 instance HasBounds (STArray s) where
 770     {-# INLINE bounds #-}
 771     bounds = GHC.Arr.boundsSTArray
 772
 773 instance MArray (STArray s) e (ST s) where
 774     {-# INLINE newArray #-}
 775     newArray    = GHC.Arr.newSTArray
 776     {-# INLINE unsafeRead #-}
 777     unsafeRead  = GHC.Arr.unsafeReadSTArray
 778     {-# INLINE unsafeWrite #-}
 779     unsafeWrite = GHC.Arr.unsafeWriteSTArray
 780
 781 -----------------------------------------------------------------------------
 782 -- Typeable instance for STArray
 783
 784 sTArrayTc :: TyCon
 785 sTArrayTc = mkTyCon "STArray"
 786
 787 instance (Typeable a, Typeable b, Typeable c) => Typeable (STArray a b c) where
 788   typeOf a = mkAppTy sTArrayTc [typeOf ((undefined :: STArray a b c -> a) a),
 789                                 typeOf ((undefined :: STArray a b c -> b) a),
 790                                 typeOf ((undefined :: STArray a b c -> c) a)]
 791
 792 -----------------------------------------------------------------------------
 793 -- Flat unboxed mutable arrays (ST monad)
 794
 795 data STUArray s i a = STUArray !i !i (MutableByteArray# s)
 796
 797 INSTANCE_TYPEABLE3(STUArray,stUArrayTc,"STUArray")
 798
 799 instance HasBounds (STUArray s) where
 800     {-# INLINE bounds #-}
 801     bounds (STUArray l u _) = (l,u)
 802
 803 instance MArray (STUArray s) Bool (ST s) where
 804     {-# INLINE newArray #-}
 805     newArray (l,u) init = ST $ \s1# ->
 806         case rangeSize (l,u)            of { I# n# ->
 807         case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
 808         case bOOL_WORD_SCALE n#         of { n'# ->
 809         let loop i# s3# | i# ==# n'# = s3#
 810                         | otherwise  =
 811                 case writeWordArray# marr# i# e# s3# of { s4# ->
 812                 loop (i# +# 1#) s4# } in
 813         case loop 0# s2#                of { s3# ->
 814         (# s3#, STUArray l u marr# #) }}}}
 815       where
 816         W# e# = if init then maxBound else 0
 817     {-# INLINE newArray_ #-}
 818     newArray_ (l,u) = ST $ \s1# ->
 819         case rangeSize (l,u)            of { I# n# ->
 820         case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
 821         (# s2#, STUArray l u marr# #) }}
 822     {-# INLINE unsafeRead #-}
 823     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
 824         case readWordArray# marr# (bOOL_INDEX i#) s1# of { (# s2#, e# #) ->
 825         (# s2#, (e# `and#` bOOL_BIT i#) `neWord#` int2Word# 0# #) }
 826     {-# INLINE unsafeWrite #-}
 827     unsafeWrite (STUArray _ _ marr#) (I# i#) e = ST $ \s1# ->
 828         case bOOL_INDEX i#              of { j# ->
 829         case readWordArray# marr# j# s1# of { (# s2#, old# #) ->
 830         case if e then old# `or#` bOOL_BIT i#
 831              else old# `and#` bOOL_NOT_BIT i# of { e# ->
 832         case writeWordArray# marr# j# e# s2# of { s3# ->
 833         (# s3#, () #) }}}}
 834
 835 instance MArray (STUArray s) Char (ST s) where
 836     {-# INLINE newArray_ #-}
 837     newArray_ (l,u) = ST $ \s1# ->
 838         case rangeSize (l,u)            of { I# n# ->
 839         case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
 840         (# s2#, STUArray l u marr# #) }}
 841     {-# INLINE unsafeRead #-}
 842     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
 843         case readWideCharArray# marr# i# s1# of { (# s2#, e# #) ->
 844         (# s2#, C# e# #) }
 845     {-# INLINE unsafeWrite #-}
 846     unsafeWrite (STUArray _ _ marr#) (I# i#) (C# e#) = ST $ \s1# ->
 847         case writeWideCharArray# marr# i# e# s1# of { s2# ->
 848         (# s2#, () #) }
 849
 850 instance MArray (STUArray s) Int (ST s) where
 851     {-# INLINE newArray_ #-}
 852     newArray_ (l,u) = ST $ \s1# ->
 853         case rangeSize (l,u)            of { I# n# ->
 854         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
 855         (# s2#, STUArray l u marr# #) }}
 856     {-# INLINE unsafeRead #-}
 857     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
 858         case readIntArray# marr# i# s1# of { (# s2#, e# #) ->
 859         (# s2#, I# e# #) }
 860     {-# INLINE unsafeWrite #-}
 861     unsafeWrite (STUArray _ _ marr#) (I# i#) (I# e#) = ST $ \s1# ->
 862         case writeIntArray# marr# i# e# s1# of { s2# ->
 863         (# s2#, () #) }
 864
 865 instance MArray (STUArray s) Word (ST s) where
 866     {-# INLINE newArray_ #-}
 867     newArray_ (l,u) = ST $ \s1# ->
 868         case rangeSize (l,u)            of { I# n# ->
 869         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
 870         (# s2#, STUArray l u marr# #) }}
 871     {-# INLINE unsafeRead #-}
 872     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
 873         case readWordArray# marr# i# s1# of { (# s2#, e# #) ->
 874         (# s2#, W# e# #) }
 875     {-# INLINE unsafeWrite #-}
 876     unsafeWrite (STUArray _ _ marr#) (I# i#) (W# e#) = ST $ \s1# ->
 877         case writeWordArray# marr# i# e# s1# of { s2# ->
 878         (# s2#, () #) }
 879
 880 instance MArray (STUArray s) (Ptr a) (ST s) where
 881     {-# INLINE newArray_ #-}
 882     newArray_ (l,u) = ST $ \s1# ->
 883         case rangeSize (l,u)            of { I# n# ->
 884         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
 885         (# s2#, STUArray l u marr# #) }}
 886     {-# INLINE unsafeRead #-}
 887     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
 888         case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
 889         (# s2#, Ptr e# #) }
 890     {-# INLINE unsafeWrite #-}
 891     unsafeWrite (STUArray _ _ marr#) (I# i#) (Ptr e#) = ST $ \s1# ->
 892         case writeAddrArray# marr# i# e# s1# of { s2# ->
 893         (# s2#, () #) }
 894
 895 instance MArray (STUArray s) (FunPtr a) (ST s) where
 896     {-# INLINE newArray_ #-}
 897     newArray_ (l,u) = ST $ \s1# ->
 898         case rangeSize (l,u)            of { I# n# ->
 899         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
 900         (# s2#, STUArray l u marr# #) }}
 901     {-# INLINE unsafeRead #-}
 902     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
 903         case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
 904         (# s2#, FunPtr e# #) }
 905     {-# INLINE unsafeWrite #-}
 906     unsafeWrite (STUArray _ _ marr#) (I# i#) (FunPtr e#) = ST $ \s1# ->
 907         case writeAddrArray# marr# i# e# s1# of { s2# ->
 908         (# s2#, () #) }
 909
 910 instance MArray (STUArray s) Float (ST s) where
 911     {-# INLINE newArray_ #-}
 912     newArray_ (l,u) = ST $ \s1# ->
 913         case rangeSize (l,u)            of { I# n# ->
 914         case newByteArray# (fLOAT_SCALE n#) s1# of { (# s2#, marr# #) ->
 915         (# s2#, STUArray l u marr# #) }}
 916     {-# INLINE unsafeRead #-}
 917     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
 918         case readFloatArray# marr# i# s1# of { (# s2#, e# #) ->
 919         (# s2#, F# e# #) }
 920     {-# INLINE unsafeWrite #-}
 921     unsafeWrite (STUArray _ _ marr#) (I# i#) (F# e#) = ST $ \s1# ->
 922         case writeFloatArray# marr# i# e# s1# of { s2# ->
 923         (# s2#, () #) }
 924
 925 instance MArray (STUArray s) Double (ST s) where
 926     {-# INLINE newArray_ #-}
 927     newArray_ (l,u) = ST $ \s1# ->
 928         case rangeSize (l,u)            of { I# n# ->
 929         case newByteArray# (dOUBLE_SCALE n#) s1# of { (# s2#, marr# #) ->
 930         (# s2#, STUArray l u marr# #) }}
 931     {-# INLINE unsafeRead #-}
 932     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
 933         case readDoubleArray# marr# i# s1# of { (# s2#, e# #) ->
 934         (# s2#, D# e# #) }
 935     {-# INLINE unsafeWrite #-}
 936     unsafeWrite (STUArray _ _ marr#) (I# i#) (D# e#) = ST $ \s1# ->
 937         case writeDoubleArray# marr# i# e# s1# of { s2# ->
 938         (# s2#, () #) }
 939
 940 instance MArray (STUArray s) (StablePtr a) (ST s) where
 941     {-# INLINE newArray_ #-}
 942     newArray_ (l,u) = ST $ \s1# ->
 943         case rangeSize (l,u)            of { I# n# ->
 944         case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
 945         (# s2#, STUArray l u marr# #) }}
 946     {-# INLINE unsafeRead #-}
 947     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
 948         case readStablePtrArray# marr# i# s1# of { (# s2#, e# #) ->
 949         (# s2# , StablePtr e# #) }
 950     {-# INLINE unsafeWrite #-}
 951     unsafeWrite (STUArray _ _ marr#) (I# i#) (StablePtr e#) = ST $ \s1# ->
 952         case writeStablePtrArray# marr# i# e# s1# of { s2# ->
 953         (# s2#, () #) }
 954
 955 instance MArray (STUArray s) Int8 (ST s) where
 956     {-# INLINE newArray_ #-}
 957     newArray_ (l,u) = ST $ \s1# ->
 958         case rangeSize (l,u)            of { I# n# ->
 959         case newByteArray# n# s1#       of { (# s2#, marr# #) ->
 960         (# s2#, STUArray l u marr# #) }}
 961     {-# INLINE unsafeRead #-}
 962     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
 963         case readInt8Array# marr# i# s1# of { (# s2#, e# #) ->
 964         (# s2#, I8# e# #) }
 965     {-# INLINE unsafeWrite #-}
 966     unsafeWrite (STUArray _ _ marr#) (I# i#) (I8# e#) = ST $ \s1# ->
 967         case writeInt8Array# marr# i# e# s1# of { s2# ->
 968         (# s2#, () #) }
 969
 970 instance MArray (STUArray s) Int16 (ST s) where
 971     {-# INLINE newArray_ #-}
 972     newArray_ (l,u) = ST $ \s1# ->
 973         case rangeSize (l,u)            of { I# n# ->
 974         case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) ->
 975         (# s2#, STUArray l u marr# #) }}
 976     {-# INLINE unsafeRead #-}
 977     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
 978         case readInt16Array# marr# i# s1# of { (# s2#, e# #) ->
 979         (# s2#, I16# e# #) }
 980     {-# INLINE unsafeWrite #-}
 981     unsafeWrite (STUArray _ _ marr#) (I# i#) (I16# e#) = ST $ \s1# ->
 982         case writeInt16Array# marr# i# e# s1# of { s2# ->
 983         (# s2#, () #) }
 984
 985 instance MArray (STUArray s) Int32 (ST s) where
 986     {-# INLINE newArray_ #-}
 987     newArray_ (l,u) = ST $ \s1# ->
 988         case rangeSize (l,u)            of { I# n# ->
 989         case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
 990         (# s2#, STUArray l u marr# #) }}
 991     {-# INLINE unsafeRead #-}
 992     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
 993         case readInt32Array# marr# i# s1# of { (# s2#, e# #) ->
 994         (# s2#, I32# e# #) }
 995     {-# INLINE unsafeWrite #-}
 996     unsafeWrite (STUArray _ _ marr#) (I# i#) (I32# e#) = ST $ \s1# ->
 997         case writeInt32Array# marr# i# e# s1# of { s2# ->
 998         (# s2#, () #) }
 999
1000 instance MArray (STUArray s) Int64 (ST s) where
1001     {-# INLINE newArray_ #-}
1002     newArray_ (l,u) = ST $ \s1# ->
1003         case rangeSize (l,u)            of { I# n# ->
1004         case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) ->
1005         (# s2#, STUArray l u marr# #) }}
1006     {-# INLINE unsafeRead #-}
1007     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1008         case readInt64Array# marr# i# s1# of { (# s2#, e# #) ->
1009         (# s2#, I64# e# #) }
1010     {-# INLINE unsafeWrite #-}
1011     unsafeWrite (STUArray _ _ marr#) (I# i#) (I64# e#) = ST $ \s1# ->
1012         case writeInt64Array# marr# i# e# s1# of { s2# ->
1013         (# s2#, () #) }
1014
1015 instance MArray (STUArray s) Word8 (ST s) where
1016     {-# INLINE newArray_ #-}
1017     newArray_ (l,u) = ST $ \s1# ->
1018         case rangeSize (l,u)            of { I# n# ->
1019         case newByteArray# n# s1#       of { (# s2#, marr# #) ->
1020         (# s2#, STUArray l u marr# #) }}
1021     {-# INLINE unsafeRead #-}
1022     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1023         case readWord8Array# marr# i# s1# of { (# s2#, e# #) ->
1024         (# s2#, W8# e# #) }
1025     {-# INLINE unsafeWrite #-}
1026     unsafeWrite (STUArray _ _ marr#) (I# i#) (W8# e#) = ST $ \s1# ->
1027         case writeWord8Array# marr# i# e# s1# of { s2# ->
1028         (# s2#, () #) }
1029
1030 instance MArray (STUArray s) Word16 (ST s) where
1031     {-# INLINE newArray_ #-}
1032     newArray_ (l,u) = ST $ \s1# ->
1033         case rangeSize (l,u)            of { I# n# ->
1034         case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) ->
1035         (# s2#, STUArray l u marr# #) }}
1036     {-# INLINE unsafeRead #-}
1037     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1038         case readWord16Array# marr# i# s1# of { (# s2#, e# #) ->
1039         (# s2#, W16# e# #) }
1040     {-# INLINE unsafeWrite #-}
1041     unsafeWrite (STUArray _ _ marr#) (I# i#) (W16# e#) = ST $ \s1# ->
1042         case writeWord16Array# marr# i# e# s1# of { s2# ->
1043         (# s2#, () #) }
1044
1045 instance MArray (STUArray s) Word32 (ST s) where
1046     {-# INLINE newArray_ #-}
1047     newArray_ (l,u) = ST $ \s1# ->
1048         case rangeSize (l,u)            of { I# n# ->
1049         case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
1050         (# s2#, STUArray l u marr# #) }}
1051     {-# INLINE unsafeRead #-}
1052     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1053         case readWord32Array# marr# i# s1# of { (# s2#, e# #) ->
1054         (# s2#, W32# e# #) }
1055     {-# INLINE unsafeWrite #-}
1056     unsafeWrite (STUArray _ _ marr#) (I# i#) (W32# e#) = ST $ \s1# ->
1057         case writeWord32Array# marr# i# e# s1# of { s2# ->
1058         (# s2#, () #) }
1059
1060 instance MArray (STUArray s) Word64 (ST s) where
1061     {-# INLINE newArray_ #-}
1062     newArray_ (l,u) = ST $ \s1# ->
1063         case rangeSize (l,u)            of { I# n# ->
1064         case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) ->
1065         (# s2#, STUArray l u marr# #) }}
1066     {-# INLINE unsafeRead #-}
1067     unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1068         case readWord64Array# marr# i# s1# of { (# s2#, e# #) ->
1069         (# s2#, W64# e# #) }
1070     {-# INLINE unsafeWrite #-}
1071     unsafeWrite (STUArray _ _ marr#) (I# i#) (W64# e#) = ST $ \s1# ->
1072         case writeWord64Array# marr# i# e# s1# of { s2# ->
1073         (# s2#, () #) }
1074
1075 -----------------------------------------------------------------------------
1076 -- Translation between elements and bytes
1077
1078 #include "config.h"
1079
1080 bOOL_SCALE, bOOL_WORD_SCALE,
1081   wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int#
1082 bOOL_SCALE n# = (n# +# last#) `iShiftRA#` 3#
1083   where I# last# = SIZEOF_VOID_P * 8 - 1
1084 bOOL_WORD_SCALE n# = bOOL_INDEX (n# +# last#)
1085   where I# last# = SIZEOF_VOID_P * 8 - 1
1086 wORD_SCALE   n# = scale# *# n# where I# scale# = SIZEOF_VOID_P
1087 dOUBLE_SCALE n# = scale# *# n# where I# scale# = SIZEOF_DOUBLE
1088 fLOAT_SCALE  n# = scale# *# n# where I# scale# = SIZEOF_FLOAT
1089
1090 bOOL_INDEX :: Int# -> Int#
1091 #if SIZEOF_VOID_P == 4
1092 bOOL_INDEX i# = i# `iShiftRA#` 5#
1093 #else
1094 bOOL_INDEX i# = i# `iShiftRA#` 6#
1095 #endif
1096
1097 bOOL_BIT, bOOL_NOT_BIT :: Int# -> Word#
1098 bOOL_BIT     n# = int2Word# 1# `shiftL#` (word2Int# (int2Word# n# `and#` mask#))
1099   where W# mask# = SIZEOF_VOID_P * 8 - 1
1100 bOOL_NOT_BIT n# = bOOL_BIT n# `xor#` mb# where W# mb# = maxBound
1101
1102 -----------------------------------------------------------------------------
1103 -- Freezing
1104
1105 freeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
1106 freeze marr | (l,u) <- bounds marr = do
1107     ies <- sequence [do e <- unsafeRead marr i; return (i,e)
1108                      | i <- [0 .. rangeSize (l,u) - 1]]
1109     return (unsafeArray (l,u) ies)
1110
1111 freezeSTUArray :: Ix i => STUArray s i e -> ST s (UArray i e)
1112 freezeSTUArray (STUArray l u marr#) = ST $ \s1# ->
1113     case sizeofMutableByteArray# marr#  of { n# ->
1114     case newByteArray# n# s1#           of { (# s2#, marr'# #) ->
1115     case unsafeCoerce# memcpy marr'# marr# n# s2# of { (# s3#, () #) ->
1116     case unsafeFreezeByteArray# marr'# s3# of { (# s4#, arr# #) ->
1117     (# s4#, UArray l u arr# #) }}}}
1118
1119 {-# RULES
1120 "freeze/STArray"  freeze = GHC.Arr.freezeSTArray
1121 "freeze/STUArray" freeze = freezeSTUArray
1122     #-}
1123
1124 -- In-place conversion of mutable arrays to immutable ones places
1125 -- a proof obligation on the user: no other parts of your code can
1126 -- have a reference to the array at the point where you unsafely
1127 -- freeze it (and, subsequently mutate it, I suspect).
1128
1129 {-# INLINE unsafeFreeze #-}
1130 unsafeFreeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
1131 unsafeFreeze = freeze
1132
1133 {-# RULES
1134 "unsafeFreeze/STArray"  unsafeFreeze = GHC.Arr.unsafeFreezeSTArray
1135 "unsafeFreeze/STUArray" unsafeFreeze = unsafeFreezeSTUArray
1136     #-}
1137
1138 -----------------------------------------------------------------------------
1139 -- Thawing
1140
1141 thaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
1142 thaw arr | (l,u) <- bounds arr = do
1143     marr <- newArray_ (l,u)
1144     sequence_ [unsafeWrite marr i (unsafeAt arr i)
1145                | i <- [0 .. rangeSize (l,u) - 1]]
1146     return marr
1147
1148 thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1149 thawSTUArray (UArray l u arr#) = ST $ \s1# ->
1150     case sizeofByteArray# arr#          of { n# ->
1151     case newByteArray# n# s1#           of { (# s2#, marr# #) ->
1152     case unsafeCoerce# memcpy marr# arr# n# s2# of { (# s3#, () #) ->
1153     (# s3#, STUArray l u marr# #) }}}
1154
1155 foreign import "memcpy" unsafe
1156     memcpy :: MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO ()
1157
1158 {-# RULES
1159 "thaw/STArray"  thaw = GHC.Arr.thawSTArray
1160 "thaw/STUArray" thaw = thawSTUArray
1161     #-}
1162
1163 -- In-place conversion of immutable arrays to mutable ones places
1164 -- a proof obligation on the user: no other parts of your code can
1165 -- have a reference to the array at the point where you unsafely
1166 -- thaw it (and, subsequently mutate it, I suspect).
1167
1168 {-# INLINE unsafeThaw #-}
1169 unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
1170 unsafeThaw = thaw
1171
1172 {-# INLINE unsafeThawSTUArray #-}
1173 unsafeThawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1174 unsafeThawSTUArray (UArray l u marr#) =
1175     return (STUArray l u (unsafeCoerce# marr#))
1176
1177 {-# RULES
1178 "unsafeThaw/STArray"    unsafeThaw = GHC.Arr.unsafeThawSTArray
1179 "unsafeThaw/STUArray"   unsafeThaw = unsafeThawSTUArray
1180     #-}