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