ghc/lib/std/PrelByteArr.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: PrelByteArr.lhs,v 1.10 2001/01/11 17:25:57 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 \end{code}
  22
  23 %*********************************************************
  24 %*                                                      *
  25 \subsection{The @Array@ types}
  26 %*                                                      *
  27 %*********************************************************
  28
  29 \begin{code}
  30 data Ix ix => ByteArray ix              = ByteArray        ix ix ByteArray#
  31 data Ix ix => MutableByteArray s ix     = MutableByteArray ix ix (MutableByteArray# s)
  32
  33 instance CCallable (ByteArray ix)
  34 instance CCallable (MutableByteArray RealWorld ix)
  35         -- Note the RealWorld!  You can only ccall with MutableByteArray args
  36         -- which are in the real world.  When this was missed out, the result
  37         -- was that a CCallOpId had a free tyvar, and since the compiler doesn't
  38         -- expect that it didn't get zonked or substituted.  Bad news.
  39
  40 instance Eq (MutableByteArray s ix) where
  41         MutableByteArray _ _ arr1# == MutableByteArray _ _ arr2#
  42                 = sameMutableByteArray# arr1# arr2#
  43 \end{code}
  44
  45 %*********************************************************
  46 %*                                                      *
  47 \subsection{Operations on mutable arrays}
  48 %*                                                      *
  49 %*********************************************************
  50
  51 Idle ADR question: What's the tradeoff here between flattening these
  52 datatypes into @MutableArray ix ix (MutableArray# s elt)@ and using
  53 it as is?  As I see it, the former uses slightly less heap and
  54 provides faster access to the individual parts of the bounds while the
  55 code used has the benefit of providing a ready-made @(lo, hi)@ pair as
  56 required by many array-related functions.  Which wins? Is the
  57 difference significant (probably not).
  58
  59 Idle AJG answer: When I looked at the outputted code (though it was 2
  60 years ago) it seems like you often needed the tuple, and we build
  61 it frequently. Now we've got the overloading specialiser things
  62 might be different, though.
  63
  64 \begin{code}
  65 newCharArray, newIntArray, newFloatArray, newDoubleArray
  66          :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
  67
  68 {-# SPECIALIZE newCharArray   :: IPr -> ST s (MutableByteArray s Int) #-}
  69 {-# SPECIALIZE newIntArray    :: IPr -> ST s (MutableByteArray s Int) #-}
  70 {-# SPECIALIZE newFloatArray  :: IPr -> ST s (MutableByteArray s Int) #-}
  71 {-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-}
  72
  73 newCharArray (l,u) = ST $ \ s# ->
  74     case rangeSize (l,u)          of { I# n# ->
  75     case (newByteArray# (cHAR_SCALE n#) s#) of { (# s2#, barr# #) ->
  76     (# s2#, MutableByteArray l u barr# #) }}
  77
  78 newIntArray (l,u) = ST $ \ s# ->
  79     case rangeSize (l,u)          of { I# n# ->
  80     case (newByteArray# (wORD_SCALE n#) s#) of { (# s2#, barr# #) ->
  81     (# s2#, MutableByteArray l u barr# #) }}
  82
  83 newWordArray (l,u) = ST $ \ s# ->
  84     case rangeSize (l,u)          of { I# n# ->
  85     case (newByteArray# (wORD_SCALE n#) s#) of { (# s2#, barr# #) ->
  86     (# s2#, MutableByteArray l u barr# #) }}
  87
  88 newFloatArray (l,u) = ST $ \ s# ->
  89     case rangeSize (l,u)          of { I# n# ->
  90     case (newByteArray# (fLOAT_SCALE n#) s#) of { (# s2#, barr# #) ->
  91     (# s2#, MutableByteArray l u barr# #) }}
  92
  93 newDoubleArray (l,u) = ST $ \ s# ->
  94     case rangeSize (l,u)          of { I# n# ->
  95     case (newByteArray# (dOUBLE_SCALE n#) s#) of { (# s2#, barr# #) ->
  96     (# s2#, MutableByteArray l u barr# #) }}
  97
  98 #include "config.h"
  99
 100   -- Char arrays really contain only 8-bit bytes for compatibility.
 101 cHAR_SCALE   n = 1# *# n
 102 wORD_SCALE   n = (case SIZEOF_VOID_P :: Int of I# x -> x *# n)
 103 dOUBLE_SCALE n = (case SIZEOF_DOUBLE :: Int of I# x -> x *# n)
 104 fLOAT_SCALE  n = (case SIZEOF_FLOAT  :: Int of I# x -> x *# n)
 105
 106 readCharArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Char
 107 readIntArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
 108 readFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
 109 readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
 110
 111 {-# SPECIALIZE readCharArray   :: MutableByteArray s Int -> Int -> ST s Char #-}
 112 {-# SPECIALIZE readIntArray    :: MutableByteArray s Int -> Int -> ST s Int #-}
 113 --NO:{-# SPECIALIZE readFloatArray  :: MutableByteArray s Int -> Int -> ST s Float #-}
 114 {-# SPECIALIZE readDoubleArray :: MutableByteArray s Int -> Int -> ST s Double #-}
 115
 116 readCharArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 117     case (index (l,u) n)                of { I# n# ->
 118     case readCharArray# barr# n# s#     of { (# s2#, r# #) ->
 119     (# s2#, C# r# #) }}
 120
 121 readIntArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 122     case (index (l,u) n)                of { I# n# ->
 123     case readIntArray# barr# n# s#      of { (# s2#, r# #) ->
 124     (# s2#, I# r# #) }}
 125
 126 readFloatArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 127     case (index (l,u) n)                of { I# n# ->
 128     case readFloatArray# barr# n# s#    of { (# s2#, r# #) ->
 129     (# s2#, F# r# #) }}
 130
 131 readDoubleArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 132     case (index (l,u) n)                of { I# n# ->
 133     case readDoubleArray# barr# n# s#   of { (# s2#, r# #) ->
 134     (# s2#, D# r# #) }}
 135
 136 --Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
 137 indexCharArray   :: Ix ix => ByteArray ix -> ix -> Char
 138 indexIntArray    :: Ix ix => ByteArray ix -> ix -> Int
 139 indexFloatArray  :: Ix ix => ByteArray ix -> ix -> Float
 140 indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double
 141
 142 {-# SPECIALIZE indexCharArray   :: ByteArray Int -> Int -> Char #-}
 143 {-# SPECIALIZE indexIntArray    :: ByteArray Int -> Int -> Int #-}
 144 --NO:{-# SPECIALIZE indexFloatArray  :: ByteArray Int -> Int -> Float #-}
 145 {-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-}
 146
 147 indexCharArray (ByteArray l u barr#) n
 148   = case (index (l,u) n)                of { I# n# ->
 149     case indexCharArray# barr# n#       of { r# ->
 150     (C# r#)}}
 151
 152 indexIntArray (ByteArray l u barr#) n
 153   = case (index (l,u) n)                of { I# n# ->
 154     case indexIntArray# barr# n#        of { r# ->
 155     (I# r#)}}
 156
 157 indexFloatArray (ByteArray l u barr#) n
 158   = case (index (l,u) n)                of { I# n# ->
 159     case indexFloatArray# barr# n#      of { r# ->
 160     (F# r#)}}
 161
 162 indexDoubleArray (ByteArray l u barr#) n
 163   = case (index (l,u) n)                of { I# n# ->
 164     case indexDoubleArray# barr# n#     of { r# ->
 165     (D# r#)}}
 166
 167 writeCharArray   :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s ()
 168 writeIntArray    :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s ()
 169 writeFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s ()
 170 writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s ()
 171
 172 {-# SPECIALIZE writeCharArray   :: MutableByteArray s Int -> Int -> Char -> ST s () #-}
 173 {-# SPECIALIZE writeIntArray    :: MutableByteArray s Int -> Int -> Int  -> ST s () #-}
 174 --NO:{-# SPECIALIZE writeFloatArray  :: MutableByteArray s Int -> Int -> Float -> ST s () #-}
 175 {-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-}
 176
 177 writeCharArray (MutableByteArray l u barr#) n (C# ele) = ST $ \ s# ->
 178     case index (l,u) n                      of { I# n# ->
 179     case writeCharArray# barr# n# ele s#    of { s2#   ->
 180     (# s2#, () #) }}
 181
 182 writeIntArray (MutableByteArray l u barr#) n (I# ele) = ST $ \ s# ->
 183     case index (l,u) n                      of { I# n# ->
 184     case writeIntArray# barr# n# ele s#     of { s2#   ->
 185     (# s2#, () #) }}
 186
 187 writeFloatArray (MutableByteArray l u barr#) n (F# ele) = ST $ \ s# ->
 188     case index (l,u) n                      of { I# n# ->
 189     case writeFloatArray# barr# n# ele s#   of { s2#   ->
 190     (# s2#, () #) }}
 191
 192 writeDoubleArray (MutableByteArray l u barr#) n (D# ele) = ST $ \ s# ->
 193     case index (l,u) n                      of { I# n# ->
 194     case writeDoubleArray# barr# n# ele s#  of { s2#   ->
 195     (# s2#, () #) }}
 196 \end{code}