ghc/lib/std/PrelByteArr.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: PrelByteArr.lhs,v 1.12 2001/02/22 13:17:58 simonpj 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 PrelNum
  18 import PrelArr
  19 import PrelFloat
  20 import PrelST
  21 import PrelBase
  22 import PrelNum ( fromInt )
  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, 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 newFloatArray  :: IPr -> ST s (MutableByteArray s Int) #-}
  73 {-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-}
  74
  75 newCharArray (l,u) = ST $ \ s# ->
  76     case rangeSize (l,u)          of { I# n# ->
  77     case (newByteArray# (cHAR_SCALE n#) s#) of { (# s2#, barr# #) ->
  78     (# s2#, MutableByteArray l u barr# #) }}
  79
  80 newIntArray (l,u) = ST $ \ s# ->
  81     case rangeSize (l,u)          of { I# n# ->
  82     case (newByteArray# (wORD_SCALE n#) s#) of { (# s2#, barr# #) ->
  83     (# s2#, MutableByteArray l u barr# #) }}
  84
  85 newWordArray (l,u) = ST $ \ s# ->
  86     case rangeSize (l,u)          of { I# n# ->
  87     case (newByteArray# (wORD_SCALE n#) s#) of { (# s2#, barr# #) ->
  88     (# s2#, MutableByteArray l u barr# #) }}
  89
  90 newFloatArray (l,u) = ST $ \ s# ->
  91     case rangeSize (l,u)          of { I# n# ->
  92     case (newByteArray# (fLOAT_SCALE n#) s#) of { (# s2#, barr# #) ->
  93     (# s2#, MutableByteArray l u barr# #) }}
  94
  95 newDoubleArray (l,u) = ST $ \ s# ->
  96     case rangeSize (l,u)          of { I# n# ->
  97     case (newByteArray# (dOUBLE_SCALE n#) s#) of { (# s2#, barr# #) ->
  98     (# s2#, MutableByteArray l u barr# #) }}
  99
 100 #include "config.h"
 101
 102   -- Char arrays really contain only 8-bit bytes for compatibility.
 103 cHAR_SCALE   n = 1# *# n
 104 wORD_SCALE   n = (case SIZEOF_VOID_P :: Int of I# x -> x *# n)
 105 dOUBLE_SCALE n = (case SIZEOF_DOUBLE :: Int of I# x -> x *# n)
 106 fLOAT_SCALE  n = (case SIZEOF_FLOAT  :: Int of I# x -> x *# n)
 107
 108 readCharArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Char
 109 readIntArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
 110 readFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
 111 readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
 112
 113 {-# SPECIALIZE readCharArray   :: MutableByteArray s Int -> Int -> ST s Char #-}
 114 {-# SPECIALIZE readIntArray    :: MutableByteArray s Int -> Int -> ST s Int #-}
 115 --NO:{-# SPECIALIZE readFloatArray  :: MutableByteArray s Int -> Int -> ST s Float #-}
 116 {-# SPECIALIZE readDoubleArray :: MutableByteArray s Int -> Int -> ST s Double #-}
 117
 118 readCharArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 119     case (index (l,u) n)                of { I# n# ->
 120     case readCharArray# barr# n# s#     of { (# s2#, r# #) ->
 121     (# s2#, C# r# #) }}
 122
 123 readIntArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 124     case (index (l,u) n)                of { I# n# ->
 125     case readIntArray# barr# n# s#      of { (# s2#, r# #) ->
 126     (# s2#, I# r# #) }}
 127
 128 readFloatArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 129     case (index (l,u) n)                of { I# n# ->
 130     case readFloatArray# barr# n# s#    of { (# s2#, r# #) ->
 131     (# s2#, F# r# #) }}
 132
 133 readDoubleArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 134     case (index (l,u) n)                of { I# n# ->
 135     case readDoubleArray# barr# n# s#   of { (# s2#, r# #) ->
 136     (# s2#, D# r# #) }}
 137
 138 --Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
 139 indexCharArray   :: Ix ix => ByteArray ix -> ix -> Char
 140 indexIntArray    :: Ix ix => ByteArray ix -> ix -> Int
 141 indexFloatArray  :: Ix ix => ByteArray ix -> ix -> Float
 142 indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double
 143
 144 {-# SPECIALIZE indexCharArray   :: ByteArray Int -> Int -> Char #-}
 145 {-# SPECIALIZE indexIntArray    :: ByteArray Int -> Int -> Int #-}
 146 --NO:{-# SPECIALIZE indexFloatArray  :: ByteArray Int -> Int -> Float #-}
 147 {-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-}
 148
 149 indexCharArray (ByteArray l u barr#) n
 150   = case (index (l,u) n)                of { I# n# ->
 151     case indexCharArray# barr# n#       of { r# ->
 152     (C# r#)}}
 153
 154 indexIntArray (ByteArray l u barr#) n
 155   = case (index (l,u) n)                of { I# n# ->
 156     case indexIntArray# barr# n#        of { r# ->
 157     (I# r#)}}
 158
 159 indexFloatArray (ByteArray l u barr#) n
 160   = case (index (l,u) n)                of { I# n# ->
 161     case indexFloatArray# barr# n#      of { r# ->
 162     (F# r#)}}
 163
 164 indexDoubleArray (ByteArray l u barr#) n
 165   = case (index (l,u) n)                of { I# n# ->
 166     case indexDoubleArray# barr# n#     of { r# ->
 167     (D# r#)}}
 168
 169 writeCharArray   :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s ()
 170 writeIntArray    :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s ()
 171 writeFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s ()
 172 writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s ()
 173
 174 {-# SPECIALIZE writeCharArray   :: MutableByteArray s Int -> Int -> Char -> ST s () #-}
 175 {-# SPECIALIZE writeIntArray    :: MutableByteArray s Int -> Int -> Int  -> ST s () #-}
 176 --NO:{-# SPECIALIZE writeFloatArray  :: MutableByteArray s Int -> Int -> Float -> ST s () #-}
 177 {-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-}
 178
 179 writeCharArray (MutableByteArray l u barr#) n (C# ele) = ST $ \ s# ->
 180     case index (l,u) n                      of { I# n# ->
 181     case writeCharArray# barr# n# ele s#    of { s2#   ->
 182     (# s2#, () #) }}
 183
 184 writeIntArray (MutableByteArray l u barr#) n (I# ele) = ST $ \ s# ->
 185     case index (l,u) n                      of { I# n# ->
 186     case writeIntArray# barr# n# ele s#     of { s2#   ->
 187     (# s2#, () #) }}
 188
 189 writeFloatArray (MutableByteArray l u barr#) n (F# ele) = ST $ \ s# ->
 190     case index (l,u) n                      of { I# n# ->
 191     case writeFloatArray# barr# n# ele s#   of { s2#   ->
 192     (# s2#, () #) }}
 193
 194 writeDoubleArray (MutableByteArray l u barr#) n (D# ele) = ST $ \ s# ->
 195     case index (l,u) n                      of { I# n# ->
 196     case writeDoubleArray# barr# n# ele s#  of { s2#   ->
 197     (# s2#, () #) }}
 198 \end{code}