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 {-
  65     readWord8Array,         -- :: Ix ix => MutableByteArray s ix -> Word8
  66     readWord16Array,        -- :: Ix ix => MutableByteArray s ix -> Word16
  67     readWord32Array,        -- :: Ix ix => MutableByteArray s ix -> Word32
  68 -}
  69     ) where
  70
  71 import PrelArr
  72 import PrelBase ( sizeofMutableByteArray#, sizeofByteArray#
  73                 , Int(..), Int#, (+#), (==#)
  74                 , StablePtr#, MutableByteArray#, State#
  75                 , unsafeFreezeByteArray#
  76                 , newStablePtrArray#, readStablePtrArray#
  77                 , indexStablePtrArray#, writeStablePtrArray#
  78                 )
  79
  80 import PrelForeign
  81 import PrelST
  82 import ST
  83 import Ix
  84
  85 \end{code}
  86
  87 Note: the absence of operations to read/write ForeignObjs to a mutable
  88 array is not accidental; storing foreign objs in a mutable array is
  89 not supported.
  90
  91 \begin{code}
  92 sizeofByteArray :: Ix ix => ByteArray ix -> Int
  93 sizeofByteArray (ByteArray _ arr#) =
  94   case (sizeofByteArray# arr#) of
  95     i# -> (I# i#)
  96
  97 sizeofMutableByteArray :: Ix ix => MutableByteArray s ix -> Int
  98 sizeofMutableByteArray (MutableByteArray _ arr#) =
  99   case (sizeofMutableByteArray# arr#) of
 100     i# -> (I# i#)
 101
 102 \end{code}
 103
 104 \begin{code}
 105 newStablePtrArray :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
 106 newStablePtrArray ixs = ST $ \ s# ->
 107     case rangeSize ixs              of { I# n# ->
 108     case (newStablePtrArray# n# s#) of { StateAndMutableByteArray# s2# barr# ->
 109     STret s2# (MutableByteArray ixs barr#) }}
 110
 111 readStablePtrArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s (StablePtr a)
 112 readStablePtrArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 113     case (index ixs n)                    of { I# n# ->
 114     case readStablePtrArray# barr# n# s#  of { StateAndStablePtr# s2# r# ->
 115     STret s2# (StablePtr r#) }}
 116
 117 indexStablePtrArray    :: Ix ix => ByteArray ix -> ix -> (StablePtr a)
 118 indexStablePtrArray (ByteArray ixs barr#) n
 119   = case (index ixs n)                  of { I# n# ->
 120     case indexStablePtrArray# barr# n#  of { r# ->
 121     (StablePtr r#)}}
 122
 123 writeStablePtrArray    :: Ix ix => MutableByteArray s ix -> ix -> StablePtr a  -> ST s ()
 124 writeStablePtrArray (MutableByteArray ixs barr#) n (StablePtr sp#) = ST $ \ s# ->
 125     case (index ixs n)                         of { I# n# ->
 126     case writeStablePtrArray# barr# n# sp# s#  of { s2#   ->
 127     STret s2# () }}
 128
 129 freezeStablePtrArray    :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 130 freezeStablePtrArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 131     case rangeSize ixs     of { I# n# ->
 132     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 133     STret s2# (ByteArray ixs frozen#) }}
 134   where
 135     freeze  :: MutableByteArray# s      -- the thing
 136             -> Int#                     -- size of thing to be frozen
 137             -> State# s                 -- the Universe and everything
 138             -> StateAndByteArray# s
 139
 140     freeze arr# n# s#
 141       = case (newStablePtrArray# n# s#)    of { StateAndMutableByteArray# s2# newarr1# ->
 142         case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
 143         unsafeFreezeByteArray# newarr2# s3#
 144         }}
 145       where
 146         copy :: Int# -> Int#
 147              -> MutableByteArray# s -> MutableByteArray# s
 148              -> State# s
 149              -> StateAndMutableByteArray# s
 150
 151         copy cur# end# from# to# s#
 152           | cur# ==# end#
 153             = StateAndMutableByteArray# s# to#
 154           | otherwise
 155             = case (readStablePtrArray#  from# cur#       s#) of { StateAndStablePtr# s1# ele ->
 156               case (writeStablePtrArray# to#   cur# ele  s1#) of { s2# ->
 157               copy (cur# +# 1#) end# from# to# s2#
 158               }}
 159
 160 \end{code}
 161
 162
 163 begin{code}
 164 readWord8Array  :: Ix ix => MutableByteArray RealWorld ix -> ix -> IO Word8
 165 readWord16Array :: Ix ix => MutableByteArray RealWorld ix -> ix -> IO Word16
 166 readWord32Array :: Ix ix => MutableByteArray RealWorld ix -> ix -> IO Word32
 167
 168 {- NB!!: The index for an array is in units of the element type being read -}
 169
 170 readWord8Array (MutableByteArray ixs arr#) n@(I# n#) =
 171     case sizeofMutableByteArray# arr#   of
 172       I# bytes#
 173        | n# ># (bytes# -# 1#) -> fail (userError "readWord8Array: index out of bounds "++show n)
 174        | otherwise            -> IO $ \ s# ->
 175          case readCharArray# barr# n# s#  of
 176            StateAndChar# s2# r# -> IOok s2# (W8# (int2Word# (ord# r#)))
 177
 178 readWord16Array (MutableByteArray ixs arr#) n@(I# n#) =
 179     case sizeofMutableByteArray# arr#   of
 180       I# bytes#
 181        | (2# *# n#) ># (bytes# -# 1#) -> fail (userError "readWord16Array: index out of bounds "++show n)
 182        | otherwise                    -> IO $ \ s# ->
 183          case readWordArray# barr# n# s#  of
 184            StateAndInt# s2# w# -> IOok s2# (wordToWord16 (W# w#))
 185
 186 readWord32Array (MutableByteArray ixs arr#) n@(I# n#) =
 187     case sizeofMutableByteArray# arr#   of
 188       I# bytes#
 189        | (4# *# n#) ># (bytes# -# 1#) -> fail (userError "readWord32Array: index out of bounds "++show n)
 190        | otherwise                    -> IO $ \ s# ->
 191          case readWordArray# barr# n# s#  of
 192            StateAndInt# s2# w# -> IOok s2# (wordToWord32 (W# w#))
 193
 194 end{code}