ghc/lib/std/PrelByteArr.lhs

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