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