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 -> Int -> IO Word8
  68     readWord16Array,        -- :: Ix ix => MutableByteArray s ix -> Int -> IO Word16
  69     readWord32Array,        -- :: Ix ix => MutableByteArray s ix -> Int -> IO Word32
  70     readWord64Array,        -- :: Ix ix => MutableByteArray s ix -> Int -> IO Word64
  71
  72     writeWord8Array,        -- :: Ix ix => MutableByteArray s ix -> Int -> Word8  -> IO ()
  73     writeWord16Array,       -- :: Ix ix => MutableByteArray s ix -> Int -> Word16 -> IO ()
  74     writeWord32Array,       -- :: Ix ix => MutableByteArray s ix -> Int -> Word32 -> IO ()
  75     writeWord64Array,       -- :: Ix ix => MutableByteArray s ix -> Int -> Word64 -> IO ()
  76
  77     readInt8Array,          -- :: Ix ix => MutableByteArray s ix -> Int -> IO Int8
  78     readInt16Array,         -- :: Ix ix => MutableByteArray s ix -> Int -> IO Int16
  79     readInt32Array,         -- :: Ix ix => MutableByteArray s ix -> Int -> IO Int32
  80     readInt64Array,         -- :: Ix ix => MutableByteArray s ix -> Int -> IO Int64
  81
  82     writeInt8Array,         -- :: Ix ix => MutableByteArray s ix -> Int -> Int8  -> IO ()
  83     writeInt16Array,        -- :: Ix ix => MutableByteArray s ix -> Int -> Int16 -> IO ()
  84     writeInt32Array,        -- :: Ix ix => MutableByteArray s ix -> Int -> Int32 -> IO ()
  85     writeInt64Array         -- :: Ix ix => MutableByteArray s ix -> Int -> Int64 -> IO ()
  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  :: MutableByteArray RealWorld Int -> Int -> IO Word8
 174 readWord16Array :: MutableByteArray RealWorld Int -> Int -> IO Word16
 175 readWord32Array :: MutableByteArray RealWorld Int -> Int -> IO Word32
 176 readWord64Array :: MutableByteArray RealWorld Int -> Int -> IO Word64
 177
 178 readWord8Array (MutableByteArray ixs arr#) n@(I# n#) =
 179     case sizeofMutableByteArray# arr#   of
 180       bytes#
 181        | n# ># (bytes# -# 1#) -> ioError (userError ("readWord8Array: index out of bounds "++show n))
 182        | otherwise            -> IO $ \ s# ->
 183          case readCharArray# arr# n# s#  of
 184            (# s2# , r# #) -> (# s2# , intToWord8 (I# (ord# r#)) #)
 185
 186 readWord16Array (MutableByteArray ixs arr#) n@(I# n#) =
 187     case sizeofMutableByteArray# arr#   of
 188       bytes#
 189        | n# ># (bytes# `quotInt#` 2# -# 1#) -> ioError (userError ("readWord16Array: index out of bounds "++show n))
 190        | otherwise                         -> IO $ \ s# ->
 191          case readWordArray# arr# (n# `quotInt#` 2#) s#  of
 192            (# s2# , w# #) ->
 193                 case n# `remInt#` 2# of
 194                    0# -> (# s2# , wordToWord16 (W# w#) #)              -- the double byte hides in the lower half of the wrd.
 195                    1# -> (# s2# , wordToWord16 (W# (shiftRL# w# 16#)) #)  -- take the upper 16 bits.
 196
 197 readWord32Array (MutableByteArray ixs arr#) n@(I# n#) =
 198     case sizeofMutableByteArray# arr#   of
 199       bytes#
 200        | n# ># (bytes# `quotInt#` 4# -# 1#) -> ioError (userError ("readWord32Array: index out of bounds "++show n))
 201        | otherwise                         -> IO $ \ s# ->
 202          case readWordArray# arr# n# s#  of
 203            (# s2# , w# #) -> (# s2# , wordToWord32 (W# w#) #)
 204
 205 readWord64Array mb n = do
 206   l <- readWord32Array mb (2*n)
 207   h <- readWord32Array mb (2*n + 1)
 208 #ifdef WORDS_BIGENDIAN
 209   return ( word32ToWord64 h + word32ToWord64 l * word32ToWord64 (maxBound::Word32))
 210 #else
 211   return ( word32ToWord64 l + word32ToWord64 h * word32ToWord64 (maxBound::Word32))
 212 #endif
 213
 214 writeWord8Array  :: MutableByteArray RealWorld Int -> Int -> Word8  -> IO ()
 215 writeWord16Array :: MutableByteArray RealWorld Int -> Int -> Word16 -> IO ()
 216 writeWord32Array :: MutableByteArray RealWorld Int -> Int -> Word32 -> IO ()
 217 writeWord64Array :: MutableByteArray RealWorld Int -> Int -> Word64 -> IO ()
 218
 219 writeWord8Array (MutableByteArray ixs arr#) n@(I# n#) w =
 220     case sizeofMutableByteArray# arr#  of
 221       bytes#
 222        | n# ># (bytes# -# 1#) -> ioError (userError ("writeWord8Array: index out of bounds "++show n))
 223        | otherwise            -> IO $ \ s# ->
 224          case writeCharArray# arr# n# (chr# (word2Int# (word8ToWord# w))) s#  of
 225            s2# -> (# s2# , () #)
 226
 227 writeWord16Array (MutableByteArray ixs arr#) n@(I# n#) w =
 228     case sizeofMutableByteArray# arr#  of
 229       bytes#
 230        | n# ># (bytes# `quotInt#` 2# -# 1#) -> ioError (userError ("writeWord16Array: index out of bounds "++show n))
 231        | otherwise            -> IO $ \ s# ->
 232          case readWordArray# arr# (n# `quotInt#` 2#) s#  of
 233            (# s2# , v# #) ->
 234               case writeWordArray# arr# (n# `quotInt#` 2#) (w# `or#` (v# `and#` mask )) s2#  of
 235                s3# -> (# s3# , () #)
 236   where
 237    w# =
 238      let w' = word16ToWord# w in
 239      case n# `remInt#` 2# of
 240         0# -> w'
 241         1# -> shiftL# w' 16#
 242
 243    mask =
 244      case n# `remInt#` 2# of
 245        0# -> case ``0xffff0000'' of W# x -> x   -- writing to the lower half of the word.
 246        1# -> int2Word# 0x0000ffff#
 247
 248 writeWord32Array (MutableByteArray ixs arr#) n@(I# n#) w =
 249     case sizeofMutableByteArray# arr#  of
 250       bytes#
 251        | n# ># (bytes# `quotInt#` 4# -# 1#) -> ioError (userError ("writeWord32Array: index out of bounds "++show n))
 252        | otherwise            -> IO $ \ s# ->
 253          case writeWordArray# arr# n# w# s#  of
 254            s2# -> (# s2# , () #)
 255   where
 256    w# = word32ToWord# w
 257
 258 writeWord64Array mb n w = do
 259 #ifdef WORDS_BIGENDIAN
 260    writeWord32Array mb (n*2) h
 261    writeWord32Array mb (n*2+1) l
 262 #else
 263    writeWord32Array mb (n*2) l
 264    writeWord32Array mb (n*2+1) h
 265 #endif
 266   where
 267     h       = word64ToWord32 h'
 268     l       = word64ToWord32 l'
 269     (h',l') = w `divMod` (word32ToWord64 (maxBound::Word32) + 1)
 270
 271
 272 \end{code}
 273
 274 \begin{code}
 275 readInt8Array  :: MutableByteArray RealWorld Int -> Int -> IO Int8
 276 readInt16Array :: MutableByteArray RealWorld Int -> Int -> IO Int16
 277 readInt32Array :: MutableByteArray RealWorld Int -> Int -> IO Int32
 278 readInt64Array :: MutableByteArray RealWorld Int -> Int -> IO Int64
 279
 280 readInt8Array (MutableByteArray ixs arr#) n@(I# n#) =
 281     case sizeofMutableByteArray# arr#   of
 282       bytes#
 283        | n# ># (bytes# -# 1#) -> ioError (userError ("readInt8Array: index out of bounds "++show n))
 284        | otherwise            -> IO $ \ s# ->
 285          case readCharArray# arr# n# s#  of
 286            (# s2# , r# #) -> (# s2# , intToInt8 (I# (ord# r#)) #)
 287
 288 readInt16Array (MutableByteArray ixs arr#) n@(I# n#) =
 289     case sizeofMutableByteArray# arr#   of
 290       bytes#
 291        | n# ># (bytes# `quotInt#` 2# -# 1#) -> ioError (userError ("readInt16Array: index out of bounds "++show n))
 292        | otherwise                         -> IO $ \ s# ->
 293          case readIntArray# arr# (n# `quotInt#` 2#) s#  of
 294            (# s2# , i# #) ->
 295                     case n# `remInt#` 2# of
 296                       0# -> (# s2# , intToInt16 (I# i#) #)
 297                       1# -> (# s2# , intToInt16 (I# i#) #) -- FIXME.
 298
 299 readInt32Array (MutableByteArray ixs arr#) n@(I# n#) =
 300     case sizeofMutableByteArray# arr#   of
 301       bytes#
 302        | n# ># (bytes# `quotInt#` 4# -# 1#) -> ioError (userError ("readInt32Array: index out of bounds "++show n))
 303        | otherwise                         -> IO $ \ s# ->
 304          case readIntArray# arr# n# s#  of
 305            (# s2# , i# #) -> (# s2# , intToInt32 (I# i#) #)
 306
 307 readInt64Array mb n = do
 308   l <- readInt32Array mb (2*n)
 309   h <- readInt32Array mb (2*n + 1)
 310 #ifdef WORDS_BIGENDIAN
 311   return ( int32ToInt64 h + int32ToInt64 l * int32ToInt64 (maxBound::Int32))
 312 #else
 313   return ( int32ToInt64 l + int32ToInt64 h * int32ToInt64 (maxBound::Int32))
 314 #endif
 315
 316 writeInt8Array  :: MutableByteArray RealWorld Int -> Int -> Int8  -> IO ()
 317 writeInt16Array :: MutableByteArray RealWorld Int -> Int -> Int16 -> IO ()
 318 writeInt32Array :: MutableByteArray RealWorld Int -> Int -> Int32 -> IO ()
 319 writeInt64Array :: MutableByteArray RealWorld Int -> Int -> Int64 -> IO ()
 320
 321 writeInt8Array (MutableByteArray ixs arr#) n@(I# n#) i =
 322     case sizeofMutableByteArray# arr#  of
 323       bytes#
 324        | n# ># (bytes# -# 1#) -> ioError (userError ("writeInt8Array: index out of bounds "++show n))
 325        | otherwise            -> IO $ \ s# ->
 326          case writeCharArray# arr# n# ch s#  of
 327            s2# -> (# s2# , () #)
 328   where
 329    ch = chr# (int8ToInt# i)
 330
 331 writeInt16Array (MutableByteArray ixs arr#) n@(I# n#) i =
 332     case sizeofMutableByteArray# arr#  of
 333       bytes#
 334        | n# ># (bytes# `quotInt#` 2# -# 1#) -> ioError (userError ("writeInt16Array: index out of bounds "++show n))
 335        | otherwise            -> IO $ \ s# ->
 336          case readIntArray# arr# (n# `quotInt#` 2#) s#  of
 337            (# s2# , v# #) ->
 338               let w' = word2Int# (int2Word# i# `or#` (int2Word# v# `and#` mask))
 339               in
 340               case writeIntArray# arr# (n# `quotInt#` 2#) w' s#  of
 341                 s2# -> (# s2# , () #)
 342   where
 343    i# =
 344      let i' = int16ToInt# i in
 345      case n# `remInt#` 2# of
 346         0# -> i'
 347         1# -> iShiftL# i' 16#
 348
 349    mask =
 350      case n# `remInt#` 2# of
 351        0# -> case ``0xffff0000'' of W# x -> x   -- writing to the lower half of the word.
 352        1# -> int2Word# 0x0000ffff#
 353
 354 writeInt32Array (MutableByteArray ixs arr#) n@(I# n#) i =
 355     case sizeofMutableByteArray# arr#  of
 356       bytes#
 357        | n# ># (bytes# `quotInt#` 4# -# 1#) -> ioError (userError ("writeInt32Array: index out of bounds "++show n))
 358        | otherwise            -> IO $ \ s# ->
 359          case writeIntArray# arr# n# i# s#  of
 360            s2# -> (# s2# , () #)
 361   where
 362    i# = int32ToInt# i
 363
 364 writeInt64Array mb n w = do
 365 #ifdef WORDS_BIGENDIAN
 366    writeInt32Array mb (n*2) h
 367    writeInt32Array mb (n*2+1) l
 368 #else
 369    writeInt32Array mb (n*2)   l
 370    writeInt32Array mb (n*2+1) h
 371 #endif
 372   where
 373     h       = int64ToInt32 h'
 374     l       = int64ToInt32 l'
 375     (h',l') = w `divMod` (int32ToInt64 (maxBound::Int32) * 2 - 1)
 376
 377 \end{code}
 378
 379 \begin{code}
 380 {-# SPECIALIZE boundsOfMutableByteArray :: MutableByteArray s Int -> IPr #-}
 381 boundsOfMutableByteArray :: Ix ix => MutableByteArray s ix -> (ix, ix)
 382 boundsOfMutableByteArray (MutableByteArray ixs _) = ixs
 383
 384 \end{code}
 385
 386 \begin{code}
 387 thawByteArray :: Ix ix => ByteArray ix -> ST s (MutableByteArray s ix)
 388 thawByteArray (ByteArray ixs barr#) =
 389      {-
 390         The implementation is made more complex by the
 391         fact that the indexes are in units of whatever
 392         base types that's stored in the byte array.
 393      -}
 394    case (sizeofByteArray# barr#) of
 395      i# -> do
 396        marr <- newCharArray (0,I# i#)
 397        mapM_ (\ idx@(I# idx#) ->
 398                  writeCharArray marr idx (C# (indexCharArray# barr# idx#)))
 399              [0..]
 400        let (MutableByteArray _ arr#) = marr
 401        return (MutableByteArray ixs arr#)
 402
 403 {-
 404   in-place conversion of immutable arrays to mutable ones places
 405   a proof obligation on the user: no other parts of your code can
 406   have a reference to the array at the point where you unsafely
 407   thaw it (and, subsequently mutate it, I suspect.)
 408 -}
 409 unsafeThawByteArray :: Ix ix => ByteArray ix -> ST s (MutableByteArray s ix)
 410 unsafeThawByteArray (ByteArray ixs barr#) = ST $ \ s# ->
 411    case unsafeThawByteArray# barr# s# of
 412       (# s2#, arr# #) -> (# s2#, MutableByteArray ixs arr# #)
 413
 414 \end{code}