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