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     boundsOfByteArray,  -- :: 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     thawArray,             -- :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
  59
  60      -- the sizes are reported back are *in bytes*.
  61     sizeofByteArray,        -- :: Ix ix => ByteArray ix -> Int
  62     sizeofMutableByteArray, -- :: Ix ix => MutableByteArray s ix -> Int
  63
  64     readWord8Array,         -- :: Ix ix => MutableByteArray s ix -> Int -> IO Word8
  65     readWord16Array,        -- :: Ix ix => MutableByteArray s ix -> Int -> IO Word16
  66     readWord32Array,        -- :: Ix ix => MutableByteArray s ix -> Int -> IO Word32
  67     readWord64Array,        -- :: Ix ix => MutableByteArray s ix -> Int -> IO Word64
  68
  69     writeWord8Array,        -- :: Ix ix => MutableByteArray s ix -> Int -> Word8  -> IO ()
  70     writeWord16Array,       -- :: Ix ix => MutableByteArray s ix -> Int -> Word16 -> IO ()
  71     writeWord32Array,       -- :: Ix ix => MutableByteArray s ix -> Int -> Word32 -> IO ()
  72     writeWord64Array,       -- :: Ix ix => MutableByteArray s ix -> Int -> Word64 -> IO ()
  73
  74     readInt8Array,          -- :: Ix ix => MutableByteArray s ix -> Int -> IO Int8
  75     readInt16Array,         -- :: Ix ix => MutableByteArray s ix -> Int -> IO Int16
  76     readInt32Array,         -- :: Ix ix => MutableByteArray s ix -> Int -> IO Int32
  77     readInt64Array,         -- :: Ix ix => MutableByteArray s ix -> Int -> IO Int64
  78
  79     writeInt8Array,         -- :: Ix ix => MutableByteArray s ix -> Int -> Int8  -> IO ()
  80     writeInt16Array,        -- :: Ix ix => MutableByteArray s ix -> Int -> Int16 -> IO ()
  81     writeInt32Array,        -- :: Ix ix => MutableByteArray s ix -> Int -> Int32 -> IO ()
  82     writeInt64Array         -- :: Ix ix => MutableByteArray s ix -> Int -> Int64 -> IO ()
  83
  84     ) where
  85
  86 import PrelIOBase
  87 import PrelBase
  88 import PrelArr
  89 import PrelAddr
  90 import PrelArrExtra
  91 import PrelForeign
  92 import PrelST
  93 import ST
  94 import Ix
  95 import Word
  96 import Int
  97
  98 \end{code}
  99
 100 Note: the absence of operations to read/write ForeignObjs to a mutable
 101 array is not accidental; storing foreign objs in a mutable array is
 102 not supported.
 103
 104 \begin{code}
 105 sizeofByteArray :: Ix ix => ByteArray ix -> Int
 106 sizeofByteArray (ByteArray _ arr#) =
 107   case (sizeofByteArray# arr#) of
 108     i# -> (I# i#)
 109
 110 sizeofMutableByteArray :: Ix ix => MutableByteArray s ix -> Int
 111 sizeofMutableByteArray (MutableByteArray _ arr#) =
 112   case (sizeofMutableByteArray# arr#) of
 113     i# -> (I# i#)
 114
 115 \end{code}
 116
 117 \begin{code}
 118 newStablePtrArray :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
 119 newStablePtrArray ixs = ST $ \ s# ->
 120     case rangeSize ixs              of { I# n# ->
 121     case (newStablePtrArray# n# s#) of { (# s2#, barr# #) ->
 122     (# s2#, (MutableByteArray ixs barr#) #) }}
 123
 124 readStablePtrArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s (StablePtr a)
 125 readStablePtrArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 126     case (index ixs n)                    of { I# n# ->
 127     case readStablePtrArray# barr# n# s#  of { (# s2#, r# #) ->
 128     (# s2# , (StablePtr r#) #) }}
 129
 130 writeStablePtrArray    :: Ix ix => MutableByteArray s ix -> ix -> StablePtr a  -> ST s ()
 131 writeStablePtrArray (MutableByteArray ixs barr#) n (StablePtr sp#) = ST $ \ s# ->
 132     case (index ixs n)                         of { I# n# ->
 133     case writeStablePtrArray# barr# n# sp# s#  of { s2#   ->
 134     (# s2# , () #) }}
 135
 136 freezeStablePtrArray    :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 137 freezeStablePtrArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 138     case rangeSize ixs     of { I# n# ->
 139     case freeze arr# n# s# of { (# s2# , frozen# #) ->
 140     (# s2# , ByteArray ixs frozen# #) }}
 141   where
 142     freeze  :: MutableByteArray# s      -- the thing
 143             -> Int#                     -- size of thing to be frozen
 144             -> State# s                 -- the Universe and everything
 145             -> (# State# s, ByteArray# #)
 146
 147     freeze arr1# n# s#
 148       = case (newStablePtrArray# n# s#)     of { (# s2# , newarr1# #) ->
 149         case copy 0# n# arr1# newarr1# s2#  of { (# s3# , newarr2# #) ->
 150         unsafeFreezeByteArray# newarr2# s3#
 151         }}
 152       where
 153         copy :: Int# -> Int#
 154              -> MutableByteArray# s -> MutableByteArray# s
 155              -> State# s
 156              -> (# State# s , MutableByteArray# s #)
 157
 158         copy cur# end# from# to# st#
 159           | cur# ==# end#
 160             = (# st# , to# #)
 161           | otherwise
 162             = case (readStablePtrArray#  from# cur#      st#) of { (# s1# , ele #) ->
 163               case (writeStablePtrArray# to#   cur# ele  s1#) of { s2# ->
 164               copy (cur# +# 1#) end# from# to# s2#
 165               }}
 166
 167 \end{code}
 168
 169
 170 Reminder: indexing an array at some base type is done in units
 171 of the size of the type being; *not* in bytes.
 172
 173 \begin{code}
 174 readWord8Array  :: MutableByteArray RealWorld Int -> Int -> IO Word8
 175 readWord16Array :: MutableByteArray RealWorld Int -> Int -> IO Word16
 176 readWord32Array :: MutableByteArray RealWorld Int -> Int -> IO Word32
 177 readWord64Array :: MutableByteArray RealWorld Int -> Int -> IO Word64
 178
 179 readWord8Array (MutableByteArray ixs arr#) n@(I# n#) =
 180     case sizeofMutableByteArray# arr#   of
 181       bytes#
 182        | n# ># (bytes# -# 1#) -> ioError (userError ("readWord8Array: index out of bounds "++show n))
 183        | otherwise            -> IO $ \ s# ->
 184          case readCharArray# arr# n# s#  of
 185            (# s2# , r# #) -> (# s2# , intToWord8 (I# (ord# r#)) #)
 186
 187 readWord16Array (MutableByteArray ixs arr#) n@(I# n#) =
 188     case sizeofMutableByteArray# arr#   of
 189       bytes#
 190        | n# ># (bytes# `quotInt#` 2# -# 1#) -> ioError (userError ("readWord16Array: index out of bounds "++show n))
 191        | otherwise                         -> IO $ \ s# ->
 192          case readWordArray# arr# (n# `quotInt#` 2#) s#  of
 193            (# s2# , w# #) ->
 194                 case n# `remInt#` 2# of
 195                    0# -> (# s2# , wordToWord16 (W# w#) #)              -- the double byte hides in the lower half of the wrd.
 196                    1# -> (# s2# , wordToWord16 (W# (shiftRL# w# 16#)) #)  -- take the upper 16 bits.
 197
 198 readWord32Array (MutableByteArray ixs arr#) n@(I# n#) =
 199     case sizeofMutableByteArray# arr#   of
 200       bytes#
 201        | n# ># (bytes# `quotInt#` 4# -# 1#) -> ioError (userError ("readWord32Array: index out of bounds "++show n))
 202        | otherwise                         -> IO $ \ s# ->
 203          case readWordArray# arr# n# s#  of
 204            (# s2# , w# #) -> (# s2# , wordToWord32 (W# w#) #)
 205
 206 readWord64Array mb n = do
 207   l <- readWord32Array mb (2*n)
 208   h <- readWord32Array mb (2*n + 1)
 209 #ifdef WORDS_BIGENDIAN
 210   return ( word32ToWord64 h + word32ToWord64 l * word32ToWord64 (maxBound::Word32))
 211 #else
 212   return ( word32ToWord64 l + word32ToWord64 h * word32ToWord64 (maxBound::Word32))
 213 #endif
 214
 215 writeWord8Array  :: MutableByteArray RealWorld Int -> Int -> Word8  -> IO ()
 216 writeWord16Array :: MutableByteArray RealWorld Int -> Int -> Word16 -> IO ()
 217 writeWord32Array :: MutableByteArray RealWorld Int -> Int -> Word32 -> IO ()
 218 writeWord64Array :: MutableByteArray RealWorld Int -> Int -> Word64 -> IO ()
 219
 220 writeWord8Array (MutableByteArray ixs arr#) n@(I# n#) w =
 221     case sizeofMutableByteArray# arr#  of
 222       bytes#
 223        | n# ># (bytes# -# 1#) -> ioError (userError ("writeWord8Array: index out of bounds "++show n))
 224        | otherwise            -> IO $ \ s# ->
 225          case writeCharArray# arr# n# (chr# (word2Int# (word8ToWord# w))) s#  of
 226            s2# -> (# s2# , () #)
 227
 228 writeWord16Array (MutableByteArray ixs arr#) n@(I# n#) w =
 229     case sizeofMutableByteArray# arr#  of
 230       bytes#
 231        | n# ># (bytes# `quotInt#` 2# -# 1#) -> ioError (userError ("writeWord16Array: index out of bounds "++show n))
 232        | otherwise            -> IO $ \ s# ->
 233          case readWordArray# arr# (n# `quotInt#` 2#) s#  of
 234            (# s2# , v# #) ->
 235               case writeWordArray# arr# (n# `quotInt#` 2#) (w# `or#` (v# `and#` mask )) s2#  of
 236                s3# -> (# s3# , () #)
 237   where
 238    w# =
 239      let w' = word16ToWord# w in
 240      case n# `remInt#` 2# of
 241         0# -> w'
 242         1# -> shiftL# w' 16#
 243
 244    mask =
 245      case n# `remInt#` 2# of
 246        0# -> case ``0xffff0000'' of W# x -> x   -- writing to the lower half of the word.
 247        1# -> int2Word# 0x0000ffff#
 248
 249 writeWord32Array (MutableByteArray ixs arr#) n@(I# n#) w =
 250     case sizeofMutableByteArray# arr#  of
 251       bytes#
 252        | n# ># (bytes# `quotInt#` 4# -# 1#) -> ioError (userError ("writeWord32Array: index out of bounds "++show n))
 253        | otherwise            -> IO $ \ s# ->
 254          case writeWordArray# arr# n# w# s#  of
 255            s2# -> (# s2# , () #)
 256   where
 257    w# = word32ToWord# w
 258
 259 writeWord64Array mb n w = do
 260 #ifdef WORDS_BIGENDIAN
 261    writeWord32Array mb (n*2) h
 262    writeWord32Array mb (n*2+1) l
 263 #else
 264    writeWord32Array mb (n*2) l
 265    writeWord32Array mb (n*2+1) h
 266 #endif
 267   where
 268     h       = word64ToWord32 h'
 269     l       = word64ToWord32 l'
 270     (h',l') = w `divMod` (word32ToWord64 (maxBound::Word32) + 1)
 271
 272
 273 \end{code}
 274
 275 \begin{code}
 276 readInt8Array  :: MutableByteArray RealWorld Int -> Int -> IO Int8
 277 readInt16Array :: MutableByteArray RealWorld Int -> Int -> IO Int16
 278 readInt32Array :: MutableByteArray RealWorld Int -> Int -> IO Int32
 279 readInt64Array :: MutableByteArray RealWorld Int -> Int -> IO Int64
 280
 281 readInt8Array (MutableByteArray ixs arr#) n@(I# n#) =
 282     case sizeofMutableByteArray# arr#   of
 283       bytes#
 284        | n# ># (bytes# -# 1#) -> ioError (userError ("readInt8Array: index out of bounds "++show n))
 285        | otherwise            -> IO $ \ s# ->
 286          case readCharArray# arr# n# s#  of
 287            (# s2# , r# #) -> (# s2# , intToInt8 (I# (ord# r#)) #)
 288
 289 readInt16Array (MutableByteArray ixs arr#) n@(I# n#) =
 290     case sizeofMutableByteArray# arr#   of
 291       bytes#
 292        | n# ># (bytes# `quotInt#` 2# -# 1#) -> ioError (userError ("readInt16Array: index out of bounds "++show n))
 293        | otherwise                         -> IO $ \ s# ->
 294          case readIntArray# arr# (n# `quotInt#` 2#) s#  of
 295            (# s2# , i# #) ->
 296                     case n# `remInt#` 2# of
 297                       0# -> (# s2# , intToInt16 (I# i#) #)
 298                       1# -> (# s2# , intToInt16 (I# i#) #) -- FIXME.
 299
 300 readInt32Array (MutableByteArray ixs arr#) n@(I# n#) =
 301     case sizeofMutableByteArray# arr#   of
 302       bytes#
 303        | n# ># (bytes# `quotInt#` 4# -# 1#) -> ioError (userError ("readInt32Array: index out of bounds "++show n))
 304        | otherwise                         -> IO $ \ s# ->
 305          case readIntArray# arr# n# s#  of
 306            (# s2# , i# #) -> (# s2# , intToInt32 (I# i#) #)
 307
 308 readInt64Array mb n = do
 309   l <- readInt32Array mb (2*n)
 310   h <- readInt32Array mb (2*n + 1)
 311 #ifdef WORDS_BIGENDIAN
 312   return ( int32ToInt64 h + int32ToInt64 l * int32ToInt64 (maxBound::Int32))
 313 #else
 314   return ( int32ToInt64 l + int32ToInt64 h * int32ToInt64 (maxBound::Int32))
 315 #endif
 316
 317 writeInt8Array  :: MutableByteArray RealWorld Int -> Int -> Int8  -> IO ()
 318 writeInt16Array :: MutableByteArray RealWorld Int -> Int -> Int16 -> IO ()
 319 writeInt32Array :: MutableByteArray RealWorld Int -> Int -> Int32 -> IO ()
 320 writeInt64Array :: MutableByteArray RealWorld Int -> Int -> Int64 -> IO ()
 321
 322 writeInt8Array (MutableByteArray ixs arr#) n@(I# n#) i =
 323     case sizeofMutableByteArray# arr#  of
 324       bytes#
 325        | n# ># (bytes# -# 1#) -> ioError (userError ("writeInt8Array: index out of bounds "++show n))
 326        | otherwise            -> IO $ \ s# ->
 327          case writeCharArray# arr# n# ch s#  of
 328            s2# -> (# s2# , () #)
 329   where
 330    ch = chr# (int8ToInt# i)
 331
 332 writeInt16Array (MutableByteArray ixs arr#) n@(I# n#) i =
 333     case sizeofMutableByteArray# arr#  of
 334       bytes#
 335        | n# ># (bytes# `quotInt#` 2# -# 1#) -> ioError (userError ("writeInt16Array: index out of bounds "++show n))
 336        | otherwise            -> IO $ \ s# ->
 337          case readIntArray# arr# (n# `quotInt#` 2#) s#  of
 338            (# s2# , v# #) ->
 339               let w' = word2Int# (int2Word# i# `or#` (int2Word# v# `and#` mask))
 340               in
 341               case writeIntArray# arr# (n# `quotInt#` 2#) w' s#  of
 342                 s2# -> (# s2# , () #)
 343   where
 344    i# =
 345      let i' = int16ToInt# i in
 346      case n# `remInt#` 2# of
 347         0# -> i'
 348         1# -> iShiftL# i' 16#
 349
 350    mask =
 351      case n# `remInt#` 2# of
 352        0# -> case ``0xffff0000'' of W# x -> x   -- writing to the lower half of the word.
 353        1# -> int2Word# 0x0000ffff#
 354
 355 writeInt32Array (MutableByteArray ixs arr#) n@(I# n#) i =
 356     case sizeofMutableByteArray# arr#  of
 357       bytes#
 358        | n# ># (bytes# `quotInt#` 4# -# 1#) -> ioError (userError ("writeInt32Array: index out of bounds "++show n))
 359        | otherwise            -> IO $ \ s# ->
 360          case writeIntArray# arr# n# i# s#  of
 361            s2# -> (# s2# , () #)
 362   where
 363    i# = int32ToInt# i
 364
 365 writeInt64Array mb n w = do
 366 #ifdef WORDS_BIGENDIAN
 367    writeInt32Array mb (n*2) h
 368    writeInt32Array mb (n*2+1) l
 369 #else
 370    writeInt32Array mb (n*2)   l
 371    writeInt32Array mb (n*2+1) h
 372 #endif
 373   where
 374     h       = int64ToInt32 h'
 375     l       = int64ToInt32 l'
 376     (h',l') = w `divMod` (int32ToInt64 (maxBound::Int32) * 2 - 1)
 377
 378 \end{code}