ghc/lib/std/PrelByteArr.lhs

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