ghc/lib/std/PrelByteArr.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: PrelByteArr.lhs,v 1.9 2000/12/12 12:19: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 (newByteArray# (cHAR_SCALE 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 (newByteArray# (wORD_SCALE 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 (newByteArray# (wORD_SCALE 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 (newByteArray# (wORD_SCALE 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 (newByteArray# (fLOAT_SCALE 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 (newByteArray# (dOUBLE_SCALE n#) s#) of { (# s2#, barr# #) ->
 105     (# s2#, MutableByteArray l u barr# #) }}
 106
 107 #include "config.h"
 108
 109   -- Char arrays really contain only 8-bit bytes for compatibility.
 110 cHAR_SCALE   n = 1# *# n
 111 wORD_SCALE   n = (case SIZEOF_VOID_P :: Int of I# x -> x *# n)
 112 dOUBLE_SCALE n = (case SIZEOF_DOUBLE :: Int of I# x -> x *# n)
 113 fLOAT_SCALE  n = (case SIZEOF_FLOAT  :: Int of I# x -> x *# n)
 114
 115 readCharArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Char
 116 readIntArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
 117 readWordArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Word
 118 readAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr
 119 readFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
 120 readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
 121
 122 {-# SPECIALIZE readCharArray   :: MutableByteArray s Int -> Int -> ST s Char #-}
 123 {-# SPECIALIZE readIntArray    :: MutableByteArray s Int -> Int -> ST s Int #-}
 124 {-# SPECIALIZE readAddrArray   :: MutableByteArray s Int -> Int -> ST s Addr #-}
 125 --NO:{-# SPECIALIZE readFloatArray  :: MutableByteArray s Int -> Int -> ST s Float #-}
 126 {-# SPECIALIZE readDoubleArray :: MutableByteArray s Int -> Int -> ST s Double #-}
 127
 128 readCharArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 129     case (index (l,u) n)                of { I# n# ->
 130     case readCharArray# barr# n# s#     of { (# s2#, r# #) ->
 131     (# s2#, C# r# #) }}
 132
 133 readIntArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 134     case (index (l,u) n)                of { I# n# ->
 135     case readIntArray# barr# n# s#      of { (# s2#, r# #) ->
 136     (# s2#, I# r# #) }}
 137
 138 readWordArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 139     case (index (l,u) n)                of { I# n# ->
 140     case readWordArray# barr# n# s#     of { (# s2#, r# #) ->
 141     (# s2#, W# r# #) }}
 142
 143 readAddrArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 144     case (index (l,u) n)                of { I# n# ->
 145     case readAddrArray# barr# n# s#     of { (# s2#, r# #) ->
 146     (# s2#, A# r# #) }}
 147
 148 readFloatArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 149     case (index (l,u) n)                of { I# n# ->
 150     case readFloatArray# barr# n# s#    of { (# s2#, r# #) ->
 151     (# s2#, F# r# #) }}
 152
 153 readDoubleArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 154     case (index (l,u) n)                of { I# n# ->
 155     case readDoubleArray# barr# n# s#   of { (# s2#, r# #) ->
 156     (# s2#, D# r# #) }}
 157
 158 --Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
 159 indexCharArray   :: Ix ix => ByteArray ix -> ix -> Char
 160 indexIntArray    :: Ix ix => ByteArray ix -> ix -> Int
 161 indexWordArray   :: Ix ix => ByteArray ix -> ix -> Word
 162 indexAddrArray   :: Ix ix => ByteArray ix -> ix -> Addr
 163 indexFloatArray  :: Ix ix => ByteArray ix -> ix -> Float
 164 indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double
 165
 166 {-# SPECIALIZE indexCharArray   :: ByteArray Int -> Int -> Char #-}
 167 {-# SPECIALIZE indexIntArray    :: ByteArray Int -> Int -> Int #-}
 168 {-# SPECIALIZE indexAddrArray   :: ByteArray Int -> Int -> Addr #-}
 169 --NO:{-# SPECIALIZE indexFloatArray  :: ByteArray Int -> Int -> Float #-}
 170 {-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-}
 171
 172 indexCharArray (ByteArray l u barr#) n
 173   = case (index (l,u) n)                of { I# n# ->
 174     case indexCharArray# barr# n#       of { r# ->
 175     (C# r#)}}
 176
 177 indexIntArray (ByteArray l u barr#) n
 178   = case (index (l,u) n)                of { I# n# ->
 179     case indexIntArray# barr# n#        of { r# ->
 180     (I# r#)}}
 181
 182 indexWordArray (ByteArray l u barr#) n
 183   = case (index (l,u) n)                of { I# n# ->
 184     case indexWordArray# barr# n#       of { r# ->
 185     (W# r#)}}
 186
 187 indexAddrArray (ByteArray l u barr#) n
 188   = case (index (l,u) n)                of { I# n# ->
 189     case indexAddrArray# barr# n#       of { r# ->
 190     (A# r#)}}
 191
 192 indexFloatArray (ByteArray l u barr#) n
 193   = case (index (l,u) n)                of { I# n# ->
 194     case indexFloatArray# barr# n#      of { r# ->
 195     (F# r#)}}
 196
 197 indexDoubleArray (ByteArray l u barr#) n
 198   = case (index (l,u) n)                of { I# n# ->
 199     case indexDoubleArray# barr# n#     of { r# ->
 200     (D# r#)}}
 201
 202 writeCharArray   :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s ()
 203 writeIntArray    :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s ()
 204 writeWordArray   :: Ix ix => MutableByteArray s ix -> ix -> Word -> ST s ()
 205 writeAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s ()
 206 writeFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s ()
 207 writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s ()
 208
 209 {-# SPECIALIZE writeCharArray   :: MutableByteArray s Int -> Int -> Char -> ST s () #-}
 210 {-# SPECIALIZE writeIntArray    :: MutableByteArray s Int -> Int -> Int  -> ST s () #-}
 211 {-# SPECIALIZE writeAddrArray   :: MutableByteArray s Int -> Int -> Addr -> ST s () #-}
 212 --NO:{-# SPECIALIZE writeFloatArray  :: MutableByteArray s Int -> Int -> Float -> ST s () #-}
 213 {-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-}
 214
 215 writeCharArray (MutableByteArray l u barr#) n (C# ele) = ST $ \ s# ->
 216     case index (l,u) n                      of { I# n# ->
 217     case writeCharArray# barr# n# ele s#    of { s2#   ->
 218     (# s2#, () #) }}
 219
 220 writeIntArray (MutableByteArray l u barr#) n (I# ele) = ST $ \ s# ->
 221     case index (l,u) n                      of { I# n# ->
 222     case writeIntArray# barr# n# ele s#     of { s2#   ->
 223     (# s2#, () #) }}
 224
 225 writeWordArray (MutableByteArray l u barr#) n (W# ele) = ST $ \ s# ->
 226     case index (l,u) n                      of { I# n# ->
 227     case writeWordArray# barr# n# ele s#    of { s2#   ->
 228     (# s2#, () #) }}
 229
 230 writeAddrArray (MutableByteArray l u barr#) n (A# ele) = ST $ \ s# ->
 231     case index (l,u) n                      of { I# n# ->
 232     case writeAddrArray# barr# n# ele s#    of { s2#   ->
 233     (# s2#, () #) }}
 234
 235 writeFloatArray (MutableByteArray l u barr#) n (F# ele) = ST $ \ s# ->
 236     case index (l,u) n                      of { I# n# ->
 237     case writeFloatArray# barr# n# ele s#   of { s2#   ->
 238     (# s2#, () #) }}
 239
 240 writeDoubleArray (MutableByteArray l u barr#) n (D# ele) = ST $ \ s# ->
 241     case index (l,u) n                      of { I# n# ->
 242     case writeDoubleArray# barr# n# ele s#  of { s2#   ->
 243     (# s2#, () #) }}
 244 \end{code}