ghc/lib/exts/MutableArray.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1997
   3 %
   4 \section[MutableArray]{The @MutableArray@ interface}
   5
   6 Mutable (byte)arrays interface, re-exports type types and operations
   7 over them from @ArrBase@. Have to be used in conjunction with
   8 @ST@.
   9
  10 \begin{code}
  11 module MutableArray
  12    (
  13     MutableArray(..),        -- not abstract
  14     MutableByteArray(..),
  15
  16     ST,
  17     Ix,
  18
  19     -- Creators:
  20     newArray,           -- :: Ix ix => (ix,ix) -> elt -> ST s (MutableArray s ix elt)
  21     newCharArray,
  22     newAddrArray,
  23     newIntArray,
  24     newFloatArray,
  25     newDoubleArray,
  26     newStablePtrArray,  -- :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
  27
  28     boundsOfArray,            -- :: Ix ix => MutableArray s ix elt -> (ix, ix)
  29     boundsOfMutableByteArray, -- :: Ix ix => MutableByteArray s ix -> (ix, ix)
  30
  31     readArray,          -- :: Ix ix => MutableArray s ix elt -> ix -> ST s elt
  32
  33     readCharArray,      -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Char
  34     readIntArray,       -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
  35     readAddrArray,      -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr
  36     readFloatArray,     -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
  37     readDoubleArray,    -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
  38     readStablePtrArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s (StablePtr a)
  39
  40     writeArray,           -- :: Ix ix => MutableArray s ix elt -> ix -> elt -> ST s ()
  41     writeCharArray,       -- :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s ()
  42     writeIntArray,        -- :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s ()
  43     writeAddrArray,       -- :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s ()
  44     writeFloatArray,      -- :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s ()
  45     writeDoubleArray,     -- :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s ()
  46     writeStablePtrArray,  -- :: Ix ix => MutableByteArray s ix -> ix -> StablePtr a -> ST s ()
  47
  48     freezeArray,          -- :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
  49     freezeCharArray,      -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
  50     freezeIntArray,       -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
  51     freezeAddrArray,      -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
  52     freezeFloatArray,     -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
  53     freezeDoubleArray,    -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
  54     freezeStablePtrArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
  55
  56     unsafeFreezeArray,     -- :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
  57     unsafeFreezeByteArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
  58
  59     thawArray,             -- :: Ix ix => Array ix elt -> ST s (MutableArray s ix)
  60     thawByteArray,         -- :: Ix ix => ByteArray ix -> ST s (MutableByteArray s ix)
  61     unsafeThawArray,       -- :: Ix ix => Array ix elt -> ST s (MutableArray s ix)
  62     unsafeThawByteArray,   -- :: Ix ix => ByteArray ix -> ST s (MutableByteArray s ix)
  63
  64      -- the sizes are reported back are *in bytes*.
  65     sizeofMutableByteArray, -- :: Ix ix => MutableByteArray s ix -> Int
  66
  67     readWord8Array,         -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Word8
  68     readWord16Array,        -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Word16
  69     readWord32Array,        -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Word32
  70     readWord64Array,        -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Word64
  71
  72     writeWord8Array,        -- :: Ix ix => MutableByteArray s ix -> ix -> Word8  -> ST s ()
  73     writeWord16Array,       -- :: Ix ix => MutableByteArray s ix -> ix -> Word16 -> ST s ()
  74     writeWord32Array,       -- :: Ix ix => MutableByteArray s ix -> ix -> Word32 -> ST s ()
  75     writeWord64Array,       -- :: Ix ix => MutableByteArray s ix -> ix -> Word64 -> ST s ()
  76
  77     readInt8Array,          -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Int8
  78     readInt16Array,         -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Int16
  79     readInt32Array,         -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Int32
  80     readInt64Array,         -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Int64
  81
  82     writeInt8Array,         -- :: Ix ix => MutableByteArray s ix -> ix -> Int8  -> ST s ()
  83     writeInt16Array,        -- :: Ix ix => MutableByteArray s ix -> ix -> Int16 -> ST s ()
  84     writeInt32Array,        -- :: Ix ix => MutableByteArray s ix -> ix -> Int32 -> ST s ()
  85     writeInt64Array         -- :: Ix ix => MutableByteArray s ix -> ix -> Int64 -> ST s ()
  86
  87     ) where
  88
  89 import PrelIOBase
  90 import PrelBase
  91 import PrelArr
  92 import PrelAddr
  93 import PrelArrExtra
  94 import PrelForeign
  95 import PrelStable
  96 import PrelST
  97 import ST
  98 import Ix
  99 import Word
 100 import Int
 101
 102 \end{code}
 103
 104 Note: the absence of operations to read/write ForeignObjs to a mutable
 105 array is not accidental; storing foreign objs in a mutable array is
 106 not supported.
 107
 108 \begin{code}
 109 sizeofMutableByteArray :: Ix ix => MutableByteArray s ix -> Int
 110 sizeofMutableByteArray (MutableByteArray _ arr#) =
 111   case (sizeofMutableByteArray# arr#) of
 112     i# -> (I# i#)
 113
 114 \end{code}
 115
 116 \begin{code}
 117 newStablePtrArray :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
 118 newStablePtrArray ixs = ST $ \ s# ->
 119     case rangeSize ixs              of { I# n# ->
 120     case (newStablePtrArray# n# s#) of { (# s2#, barr# #) ->
 121     (# s2#, (MutableByteArray ixs barr#) #) }}
 122
 123 readStablePtrArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s (StablePtr a)
 124 readStablePtrArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 125     case (index ixs n)                    of { I# n# ->
 126     case readStablePtrArray# barr# n# s#  of { (# s2#, r# #) ->
 127     (# s2# , (StablePtr r#) #) }}
 128
 129 writeStablePtrArray    :: Ix ix => MutableByteArray s ix -> ix -> StablePtr a  -> ST s ()
 130 writeStablePtrArray (MutableByteArray ixs barr#) n (StablePtr sp#) = ST $ \ s# ->
 131     case (index ixs n)                         of { I# n# ->
 132     case writeStablePtrArray# barr# n# sp# s#  of { s2#   ->
 133     (# s2# , () #) }}
 134
 135 freezeStablePtrArray    :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 136 freezeStablePtrArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 137     case rangeSize ixs     of { I# n# ->
 138     case freeze arr# n# s# of { (# s2# , frozen# #) ->
 139     (# s2# , ByteArray ixs frozen# #) }}
 140   where
 141     freeze  :: MutableByteArray# s      -- the thing
 142             -> Int#                     -- size of thing to be frozen
 143             -> State# s                 -- the Universe and everything
 144             -> (# State# s, ByteArray# #)
 145
 146     freeze arr1# n# s#
 147       = case (newStablePtrArray# n# s#)     of { (# s2# , newarr1# #) ->
 148         case copy 0# n# arr1# newarr1# s2#  of { (# s3# , newarr2# #) ->
 149         unsafeFreezeByteArray# newarr2# s3#
 150         }}
 151       where
 152         copy :: Int# -> Int#
 153              -> MutableByteArray# s -> MutableByteArray# s
 154              -> State# s
 155              -> (# State# s , MutableByteArray# s #)
 156
 157         copy cur# end# from# to# st#
 158           | cur# ==# end#
 159             = (# st# , to# #)
 160           | otherwise
 161             = case (readStablePtrArray#  from# cur#      st#) of { (# s1# , ele #) ->
 162               case (writeStablePtrArray# to#   cur# ele  s1#) of { s2# ->
 163               copy (cur# +# 1#) end# from# to# s2#
 164               }}
 165
 166 \end{code}
 167
 168
 169 Reminder: indexing an array at some base type is done in units
 170 of the size of the type being; *not* in bytes.
 171
 172 \begin{code}
 173 readWord8Array  :: (Ix ix) => MutableByteArray s ix -> ix -> ST s Word8
 174 readWord16Array :: (Ix ix) => MutableByteArray s ix -> ix -> ST s Word16
 175 readWord32Array :: (Ix ix) => MutableByteArray s ix -> ix -> ST s Word32
 176
 177 readWord8Array (MutableByteArray ixs arr#) n = ST $ \ s# ->
 178     case (index ixs n)              of { I# n# ->
 179     case readCharArray# arr# n# s#  of { (# s2# , r# #) ->
 180     (# s2# , intToWord8 (I# (ord# r#)) #) }}
 181
 182
 183 readWord16Array (MutableByteArray ixs arr#) n = ST $ \ s# ->
 184     case (index ixs n)                              of { I# n# ->
 185     case readWordArray# arr# (n# `quotInt#` 2#) s#  of { (# s2# , w# #) ->
 186     case n# `remInt#` 2# of
 187       0# -> (# s2# , wordToWord16 (W# w#) #)
 188               -- the double byte hides in the lower half of the wrd.
 189       1# -> (# s2# , wordToWord16 (W# (shiftRL# w# 16#)) #)
 190               -- take the upper 16 bits.
 191     }}
 192
 193 readWord32Array (MutableByteArray ixs arr#) n = ST $ \ s# ->
 194     case (index ixs n)                  of { I# n# ->
 195     case readWordArray# arr# n# s#      of { (# s2# , w# #) ->
 196     (# s2# , wordToWord32 (W# w#) #) }}
 197
 198
 199   -- FIXME, Num shouldn't be required, but it makes my life easier.
 200 readWord64Array :: (Num ix, Ix ix) => MutableByteArray s ix -> ix -> ST s Word64
 201 readWord64Array mb n = do
 202   l <- readWord32Array mb (2*n)
 203   h <- readWord32Array mb (2*n + 1)
 204 #ifdef WORDS_BIGENDIAN
 205   return ( word32ToWord64 h + word32ToWord64 l * word32ToWord64 (maxBound::Word32))
 206 #else
 207   return ( word32ToWord64 l + word32ToWord64 h * word32ToWord64 (maxBound::Word32))
 208 #endif
 209
 210 writeWord8Array  :: (Ix ix) => MutableByteArray s ix -> ix -> Word8  -> ST s ()
 211 writeWord16Array :: (Ix ix) => MutableByteArray s ix -> ix -> Word16 -> ST s ()
 212 writeWord32Array :: (Ix ix) => MutableByteArray s ix -> ix -> Word32 -> ST s ()
 213
 214 writeWord8Array (MutableByteArray ixs arr#) n w = ST $ \ s# ->
 215     case (index ixs n) of
 216       I# n# -> case writeCharArray# arr# n# (chr# (word2Int# (word8ToWord# w))) s#  of
 217                     s2# -> (# s2# , () #)
 218
 219 writeWord16Array (MutableByteArray ixs arr#) n w = ST $ \ s# ->
 220     case (index ixs n) of
 221       I# n# ->
 222          let
 223           w# =
 224             let w' = word16ToWord# w in
 225             case n# `remInt#` 2# of
 226               0# -> w'
 227               1# -> shiftL# w' 16#
 228
 229           mask =
 230             case n# `remInt#` 2# of
 231               0# -> case ``0xffff0000'' of W# x -> x   -- writing to the lower half of the word.
 232               1# -> int2Word# 0x0000ffff#
 233          in
 234          case readWordArray# arr# (n# `quotInt#` 2#) s#  of
 235            (# s2# , v# #) ->
 236               case writeWordArray# arr# (n# `quotInt#` 2#) (w# `or#` (v# `and#` mask )) s2#  of
 237                s3# -> (# s3# , () #)
 238
 239 writeWord32Array (MutableByteArray ixs arr#) n w = ST $ \ s# ->
 240     case (index ixs n) of
 241       I# n# ->
 242         case writeWordArray# arr# n# w# s#  of
 243           s2# -> (# s2# , () #)
 244   where
 245    w# = word32ToWord# w
 246
 247   -- FIXME, Num shouldn't be required, but it makes my life easier.
 248 writeWord64Array :: (Num ix, Ix ix) => MutableByteArray s ix -> ix -> Word64 -> ST s ()
 249 writeWord64Array mb n w = do
 250 #ifdef WORDS_BIGENDIAN
 251    writeWord32Array mb (n*2) h
 252    writeWord32Array mb (n*2+1) l
 253 #else
 254    writeWord32Array mb (n*2) l
 255    writeWord32Array mb (n*2+1) h
 256 #endif
 257   where
 258     h       = word64ToWord32 h'
 259     l       = word64ToWord32 l'
 260     (h',l') = w `divMod` (word32ToWord64 (maxBound::Word32) + 1)
 261
 262
 263 \end{code}
 264
 265 \begin{code}
 266 readInt8Array  :: (Ix ix) => MutableByteArray s ix -> ix -> ST s Int8
 267 readInt16Array :: (Ix ix) => MutableByteArray s ix -> ix -> ST s Int16
 268 readInt32Array :: (Ix ix) => MutableByteArray s ix -> ix -> ST s Int32
 269
 270 readInt8Array (MutableByteArray ixs arr#) n = ST $ \ s# ->
 271     case (index ixs n)              of { I# n# ->
 272     case readCharArray# arr# n# s#  of { (# s2# , r# #) ->
 273     (# s2# , intToInt8 (I# (ord# r#)) #) }}
 274
 275 readInt16Array (MutableByteArray ixs arr#) n = ST $ \ s# ->
 276     case (index ixs n) of
 277      I# n# ->
 278        case readIntArray# arr# (n# `quotInt#` 2#) s#  of
 279         (# s2# , i# #) ->
 280           case n# `remInt#` 2# of
 281              0# -> (# s2# , intToInt16 (I# i#) #)
 282              1# -> (# s2# , intToInt16 (I# (word2Int# (shiftRL# (int2Word# i#) 16# ))) #)
 283
 284 readInt32Array (MutableByteArray ixs arr#) n = ST $ \ s# ->
 285     case (index ixs n) of
 286       I# n# -> case readIntArray# arr# n# s# of
 287                  (# s2# , i# #) -> (# s2# , intToInt32 (I# i#) #)
 288
 289 readInt64Array :: (Num ix, Ix ix) => MutableByteArray s ix -> ix -> ST s Int64
 290 readInt64Array mb n = do
 291   l <- readInt32Array mb (2*n)
 292   h <- readInt32Array mb (2*n + 1)
 293 #ifdef WORDS_BIGENDIAN
 294   return ( int32ToInt64 h + int32ToInt64 l * int32ToInt64 (maxBound::Int32))
 295 #else
 296   return ( int32ToInt64 l + int32ToInt64 h * int32ToInt64 (maxBound::Int32))
 297 #endif
 298
 299 writeInt8Array  :: (Ix ix) => MutableByteArray s ix -> ix -> Int8  -> ST s ()
 300 writeInt16Array :: (Ix ix) => MutableByteArray s ix -> ix -> Int16 -> ST s ()
 301 writeInt32Array :: (Ix ix) => MutableByteArray s ix -> ix -> Int32 -> ST s ()
 302
 303 writeInt8Array (MutableByteArray ixs arr#) n i = ST $ \ s# ->
 304     case (index ixs n) of
 305       I# n# ->
 306         case writeCharArray# arr# n# ch s#  of
 307            s2# -> (# s2# , () #)
 308   where
 309    ch = chr# (int8ToInt# i)
 310
 311 writeInt16Array (MutableByteArray ixs arr#) n i = ST $ \ s# ->
 312     case (index ixs n) of
 313       I# n# ->
 314          let
 315           i# =
 316             let i' = int16ToInt# i in
 317             case n# `remInt#` 2# of
 318               0# -> i'
 319               1# -> iShiftL# i' 16#
 320
 321           mask =
 322             case n# `remInt#` 2# of
 323               0# -> case ``0xffff0000'' of W# x -> x   -- writing to the lower half of the word.
 324               1# -> int2Word# 0x0000ffff#
 325          in
 326          case readIntArray# arr# (n# `quotInt#` 2#) s#  of
 327            (# s2# , v# #) ->
 328               let w' = word2Int# (int2Word# i# `or#` (int2Word# v# `and#` mask))
 329               in
 330               case writeIntArray# arr# (n# `quotInt#` 2#) w' s#  of
 331                 s2# -> (# s2# , () #)
 332
 333 writeInt32Array (MutableByteArray ixs arr#) n i = ST $ \ s# ->
 334    case (index ixs n) of
 335      I# n# ->
 336         case writeIntArray# arr# n# i# s#  of
 337           s2# -> (# s2# , () #)
 338   where
 339    i# = int32ToInt# i
 340
 341 writeInt64Array :: (Num ix, Ix ix) => MutableByteArray s ix -> ix -> Int64 -> ST s ()
 342 writeInt64Array mb n w = do
 343 #ifdef WORDS_BIGENDIAN
 344    writeInt32Array mb (n*2) h
 345    writeInt32Array mb (n*2+1) l
 346 #else
 347    writeInt32Array mb (n*2)   l
 348    writeInt32Array mb (n*2+1) h
 349 #endif
 350   where
 351     h       = int64ToInt32 h'
 352     l       = int64ToInt32 l'
 353     (h',l') = w `divMod` (int32ToInt64 (maxBound::Int32) * 2 - 1)
 354
 355 \end{code}
 356
 357 \begin{code}
 358 {-# SPECIALIZE boundsOfMutableByteArray :: MutableByteArray s Int -> IPr #-}
 359 boundsOfMutableByteArray :: Ix ix => MutableByteArray s ix -> (ix, ix)
 360 boundsOfMutableByteArray (MutableByteArray ixs _) = ixs
 361
 362 \end{code}
 363
 364 \begin{code}
 365 thawByteArray :: Ix ix => ByteArray ix -> ST s (MutableByteArray s ix)
 366 thawByteArray (ByteArray ixs barr#) =
 367      {-
 368         The implementation is made more complex by the
 369         fact that the indexes are in units of whatever
 370         base types that's stored in the byte array.
 371      -}
 372    case (sizeofByteArray# barr#) of
 373      i# -> do
 374        marr <- newCharArray (0,I# i#)
 375        mapM_ (\ idx@(I# idx#) ->
 376                  writeCharArray marr idx (C# (indexCharArray# barr# idx#)))
 377              [0..]
 378        let (MutableByteArray _ arr#) = marr
 379        return (MutableByteArray ixs arr#)
 380
 381 {-
 382   in-place conversion of immutable arrays to mutable ones places
 383   a proof obligation on the user: no other parts of your code can
 384   have a reference to the array at the point where you unsafely
 385   thaw it (and, subsequently mutate it, I suspect.)
 386 -}
 387 unsafeThawByteArray :: Ix ix => ByteArray ix -> ST s (MutableByteArray s ix)
 388 unsafeThawByteArray (ByteArray ixs barr#) = ST $ \ s# ->
 389    case unsafeThawByteArray# barr# s# of
 390       (# s2#, arr# #) -> (# s2#, MutableByteArray ixs arr# #)
 391
 392 \end{code}