ghc/lib/std/PrelByteArr.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: PrelByteArr.lhs,v 1.8 2000/07/07 11:03:58 simonmar Exp $
   3 %
   4 % (c) The University of Glasgow, 1994-2000
   5 %
   6
   7 \section[PrelByteArr]{Module @PrelByteArr@}
   8
   9 Byte-arrays are flat arrays of non-pointers only.
  10
  11 \begin{code}
  12 {-# OPTIONS -fno-implicit-prelude #-}
  13
  14 module PrelByteArr where
  15
  16 import {-# SOURCE #-} PrelErr ( error )
  17 import PrelArr
  18 import PrelFloat
  19 import PrelST
  20 import PrelBase
  21 import PrelAddr
  22
  23 \end{code}
  24
  25 %*********************************************************
  26 %*                                                      *
  27 \subsection{The @Array@ types}
  28 %*                                                      *
  29 %*********************************************************
  30
  31 \begin{code}
  32 data Ix ix => ByteArray ix              = ByteArray        ix ix ByteArray#
  33 data Ix ix => MutableByteArray s ix     = MutableByteArray ix ix (MutableByteArray# s)
  34
  35 instance CCallable (ByteArray ix)
  36 instance CCallable (MutableByteArray RealWorld ix)
  37         -- Note the RealWorld!  You can only ccall with MutableByteArray args
  38         -- which are in the real world.  When this was missed out, the result
  39         -- was that a CCallOpId had a free tyvar, and since the compiler doesn't
  40         -- expect that it didn't get zonked or substituted.  Bad news.
  41
  42 instance Eq (MutableByteArray s ix) where
  43         MutableByteArray _ _ arr1# == MutableByteArray _ _ arr2#
  44                 = sameMutableByteArray# arr1# arr2#
  45 \end{code}
  46
  47 %*********************************************************
  48 %*                                                      *
  49 \subsection{Operations on mutable arrays}
  50 %*                                                      *
  51 %*********************************************************
  52
  53 Idle ADR question: What's the tradeoff here between flattening these
  54 datatypes into @MutableArray ix ix (MutableArray# s elt)@ and using
  55 it as is?  As I see it, the former uses slightly less heap and
  56 provides faster access to the individual parts of the bounds while the
  57 code used has the benefit of providing a ready-made @(lo, hi)@ pair as
  58 required by many array-related functions.  Which wins? Is the
  59 difference significant (probably not).
  60
  61 Idle AJG answer: When I looked at the outputted code (though it was 2
  62 years ago) it seems like you often needed the tuple, and we build
  63 it frequently. Now we've got the overloading specialiser things
  64 might be different, though.
  65
  66 \begin{code}
  67 newCharArray, newIntArray, newWordArray, newAddrArray, newFloatArray, newDoubleArray
  68          :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
  69
  70 {-# SPECIALIZE newCharArray   :: IPr -> ST s (MutableByteArray s Int) #-}
  71 {-# SPECIALIZE newIntArray    :: IPr -> ST s (MutableByteArray s Int) #-}
  72 {-# SPECIALIZE newWordArray   :: IPr -> ST s (MutableByteArray s Int) #-}
  73 {-# SPECIALIZE newAddrArray   :: IPr -> ST s (MutableByteArray s Int) #-}
  74 {-# SPECIALIZE newFloatArray  :: IPr -> ST s (MutableByteArray s Int) #-}
  75 {-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-}
  76
  77 newCharArray (l,u) = ST $ \ s# ->
  78     case rangeSize (l,u)          of { I# n# ->
  79     case (newCharArray# n# s#)    of { (# s2#, barr# #) ->
  80     (# s2#, MutableByteArray l u barr# #) }}
  81
  82 newIntArray (l,u) = ST $ \ s# ->
  83     case rangeSize (l,u)          of { I# n# ->
  84     case (newIntArray# n# s#)     of { (# s2#, barr# #) ->
  85     (# s2#, MutableByteArray l u barr# #) }}
  86
  87 newWordArray (l,u) = ST $ \ s# ->
  88     case rangeSize (l,u)          of { I# n# ->
  89     case (newWordArray# n# s#)    of { (# s2#, barr# #) ->
  90     (# s2#, MutableByteArray l u barr# #) }}
  91
  92 newAddrArray (l,u) = ST $ \ s# ->
  93     case rangeSize (l,u)          of { I# n# ->
  94     case (newAddrArray# n# s#)    of { (# s2#, barr# #) ->
  95     (# s2#, MutableByteArray l u barr# #) }}
  96
  97 newFloatArray (l,u) = ST $ \ s# ->
  98     case rangeSize (l,u)          of { I# n# ->
  99     case (newFloatArray# n# s#)   of { (# s2#, barr# #) ->
 100     (# s2#, MutableByteArray l u barr# #) }}
 101
 102 newDoubleArray (l,u) = ST $ \ s# ->
 103     case rangeSize (l,u)          of { I# n# ->
 104     case (newDoubleArray# n# s#)  of { (# s2#, barr# #) ->
 105     (# s2#, MutableByteArray l u barr# #) }}
 106
 107
 108 readCharArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Char
 109 readIntArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
 110 readWordArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Word
 111 readAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr
 112 readFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
 113 readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
 114
 115 {-# SPECIALIZE readCharArray   :: MutableByteArray s Int -> Int -> ST s Char #-}
 116 {-# SPECIALIZE readIntArray    :: MutableByteArray s Int -> Int -> ST s Int #-}
 117 {-# SPECIALIZE readAddrArray   :: MutableByteArray s Int -> Int -> ST s Addr #-}
 118 --NO:{-# SPECIALIZE readFloatArray  :: MutableByteArray s Int -> Int -> ST s Float #-}
 119 {-# SPECIALIZE readDoubleArray :: MutableByteArray s Int -> Int -> ST s Double #-}
 120
 121 readCharArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 122     case (index (l,u) n)                of { I# n# ->
 123     case readCharArray# barr# n# s#     of { (# s2#, r# #) ->
 124     (# s2#, C# r# #) }}
 125
 126 readIntArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 127     case (index (l,u) n)                of { I# n# ->
 128     case readIntArray# barr# n# s#      of { (# s2#, r# #) ->
 129     (# s2#, I# r# #) }}
 130
 131 readWordArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 132     case (index (l,u) n)                of { I# n# ->
 133     case readWordArray# barr# n# s#     of { (# s2#, r# #) ->
 134     (# s2#, W# r# #) }}
 135
 136 readAddrArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 137     case (index (l,u) n)                of { I# n# ->
 138     case readAddrArray# barr# n# s#     of { (# s2#, r# #) ->
 139     (# s2#, A# r# #) }}
 140
 141 readFloatArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 142     case (index (l,u) n)                of { I# n# ->
 143     case readFloatArray# barr# n# s#    of { (# s2#, r# #) ->
 144     (# s2#, F# r# #) }}
 145
 146 readDoubleArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 147     case (index (l,u) n)                of { I# n# ->
 148     case readDoubleArray# barr# n# s#   of { (# s2#, r# #) ->
 149     (# s2#, D# r# #) }}
 150
 151 --Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
 152 indexCharArray   :: Ix ix => ByteArray ix -> ix -> Char
 153 indexIntArray    :: Ix ix => ByteArray ix -> ix -> Int
 154 indexWordArray   :: Ix ix => ByteArray ix -> ix -> Word
 155 indexAddrArray   :: Ix ix => ByteArray ix -> ix -> Addr
 156 indexFloatArray  :: Ix ix => ByteArray ix -> ix -> Float
 157 indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double
 158
 159 {-# SPECIALIZE indexCharArray   :: ByteArray Int -> Int -> Char #-}
 160 {-# SPECIALIZE indexIntArray    :: ByteArray Int -> Int -> Int #-}
 161 {-# SPECIALIZE indexAddrArray   :: ByteArray Int -> Int -> Addr #-}
 162 --NO:{-# SPECIALIZE indexFloatArray  :: ByteArray Int -> Int -> Float #-}
 163 {-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-}
 164
 165 indexCharArray (ByteArray l u barr#) n
 166   = case (index (l,u) n)                of { I# n# ->
 167     case indexCharArray# barr# n#       of { r# ->
 168     (C# r#)}}
 169
 170 indexIntArray (ByteArray l u barr#) n
 171   = case (index (l,u) n)                of { I# n# ->
 172     case indexIntArray# barr# n#        of { r# ->
 173     (I# r#)}}
 174
 175 indexWordArray (ByteArray l u barr#) n
 176   = case (index (l,u) n)                of { I# n# ->
 177     case indexWordArray# barr# n#       of { r# ->
 178     (W# r#)}}
 179
 180 indexAddrArray (ByteArray l u barr#) n
 181   = case (index (l,u) n)                of { I# n# ->
 182     case indexAddrArray# barr# n#       of { r# ->
 183     (A# r#)}}
 184
 185 indexFloatArray (ByteArray l u barr#) n
 186   = case (index (l,u) n)                of { I# n# ->
 187     case indexFloatArray# barr# n#      of { r# ->
 188     (F# r#)}}
 189
 190 indexDoubleArray (ByteArray l u barr#) n
 191   = case (index (l,u) n)                of { I# n# ->
 192     case indexDoubleArray# barr# n#     of { r# ->
 193     (D# r#)}}
 194
 195 writeCharArray   :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s ()
 196 writeIntArray    :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s ()
 197 writeWordArray   :: Ix ix => MutableByteArray s ix -> ix -> Word -> ST s ()
 198 writeAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s ()
 199 writeFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s ()
 200 writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s ()
 201
 202 {-# SPECIALIZE writeCharArray   :: MutableByteArray s Int -> Int -> Char -> ST s () #-}
 203 {-# SPECIALIZE writeIntArray    :: MutableByteArray s Int -> Int -> Int  -> ST s () #-}
 204 {-# SPECIALIZE writeAddrArray   :: MutableByteArray s Int -> Int -> Addr -> ST s () #-}
 205 --NO:{-# SPECIALIZE writeFloatArray  :: MutableByteArray s Int -> Int -> Float -> ST s () #-}
 206 {-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-}
 207
 208 writeCharArray (MutableByteArray l u barr#) n (C# ele) = ST $ \ s# ->
 209     case index (l,u) n                      of { I# n# ->
 210     case writeCharArray# barr# n# ele s#    of { s2#   ->
 211     (# s2#, () #) }}
 212
 213 writeIntArray (MutableByteArray l u barr#) n (I# ele) = ST $ \ s# ->
 214     case index (l,u) n                      of { I# n# ->
 215     case writeIntArray# barr# n# ele s#     of { s2#   ->
 216     (# s2#, () #) }}
 217
 218 writeWordArray (MutableByteArray l u barr#) n (W# ele) = ST $ \ s# ->
 219     case index (l,u) n                      of { I# n# ->
 220     case writeWordArray# barr# n# ele s#    of { s2#   ->
 221     (# s2#, () #) }}
 222
 223 writeAddrArray (MutableByteArray l u barr#) n (A# ele) = ST $ \ s# ->
 224     case index (l,u) n                      of { I# n# ->
 225     case writeAddrArray# barr# n# ele s#    of { s2#   ->
 226     (# s2#, () #) }}
 227
 228 writeFloatArray (MutableByteArray l u barr#) n (F# ele) = ST $ \ s# ->
 229     case index (l,u) n                      of { I# n# ->
 230     case writeFloatArray# barr# n# ele s#   of { s2#   ->
 231     (# s2#, () #) }}
 232
 233 writeDoubleArray (MutableByteArray l u barr#) n (D# ele) = ST $ \ s# ->
 234     case index (l,u) n                      of { I# n# ->
 235     case writeDoubleArray# barr# n# ele s#  of { s2#   ->
 236     (# s2#, () #) }}
 237 \end{code}