ghc/lib/std/PrelByteArr.lhs

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