ghc/lib/std/PrelByteArr.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4 \section[PrelByteArr]{Module @PrelByteArr@}
   5
   6 Byte-arrays are flat arrays of non-pointers only.
   7
   8 \begin{code}
   9 {-# OPTIONS -fno-implicit-prelude #-}
  10
  11 module PrelByteArr where
  12
  13 import {-# SOURCE #-} PrelErr ( error )
  14 import PrelArr
  15 import PrelFloat
  16 import Ix
  17 import PrelList (foldl)
  18 import PrelST
  19 import PrelBase
  20 import PrelAddr
  21 import PrelGHC
  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 (MutableByteArray s ix)
  36 instance CCallable (ByteArray ix)
  37
  38 instance Eq (MutableByteArray s ix) where
  39         MutableByteArray _ _ arr1# == MutableByteArray _ _ arr2#
  40                 = sameMutableByteArray# arr1# arr2#
  41 \end{code}
  42
  43 %*********************************************************
  44 %*                                                      *
  45 \subsection{Operations on mutable arrays}
  46 %*                                                      *
  47 %*********************************************************
  48
  49 Idle ADR question: What's the tradeoff here between flattening these
  50 datatypes into @MutableArray ix ix (MutableArray# s elt)@ and using
  51 it as is?  As I see it, the former uses slightly less heap and
  52 provides faster access to the individual parts of the bounds while the
  53 code used has the benefit of providing a ready-made @(lo, hi)@ pair as
  54 required by many array-related functions.  Which wins? Is the
  55 difference significant (probably not).
  56
  57 Idle AJG answer: When I looked at the outputted code (though it was 2
  58 years ago) it seems like you often needed the tuple, and we build
  59 it frequently. Now we've got the overloading specialiser things
  60 might be different, though.
  61
  62 \begin{code}
  63 newCharArray, newIntArray, newWordArray, newAddrArray, newFloatArray, newDoubleArray
  64          :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
  65
  66 {-# SPECIALIZE newCharArray   :: IPr -> ST s (MutableByteArray s Int) #-}
  67 {-# SPECIALIZE newIntArray    :: IPr -> ST s (MutableByteArray s Int) #-}
  68 {-# SPECIALIZE newWordArray   :: IPr -> ST s (MutableByteArray s Int) #-}
  69 {-# SPECIALIZE newAddrArray   :: 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 (newCharArray# 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 (newIntArray# 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 (newWordArray# n# s#)    of { (# s2#, barr# #) ->
  86     (# s2#, MutableByteArray l u barr# #) }}
  87
  88 newAddrArray (l,u) = ST $ \ s# ->
  89     case rangeSize (l,u)          of { I# n# ->
  90     case (newAddrArray# n# s#)    of { (# s2#, barr# #) ->
  91     (# s2#, MutableByteArray l u barr# #) }}
  92
  93 newFloatArray (l,u) = ST $ \ s# ->
  94     case rangeSize (l,u)          of { I# n# ->
  95     case (newFloatArray# n# s#)   of { (# s2#, barr# #) ->
  96     (# s2#, MutableByteArray l u barr# #) }}
  97
  98 newDoubleArray (l,u) = ST $ \ s# ->
  99     case rangeSize (l,u)          of { I# n# ->
 100     case (newDoubleArray# n# s#)  of { (# s2#, barr# #) ->
 101     (# s2#, MutableByteArray l u barr# #) }}
 102
 103
 104 readCharArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Char
 105 readIntArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
 106 readWordArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Word
 107 readAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr
 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 {-# SPECIALIZE readAddrArray   :: MutableByteArray s Int -> Int -> ST s Addr #-}
 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 readWordArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 128     case (index (l,u) n)                of { I# n# ->
 129     case readWordArray# barr# n# s#     of { (# s2#, r# #) ->
 130     (# s2#, W# r# #) }}
 131
 132 readAddrArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 133     case (index (l,u) n)                of { I# n# ->
 134     case readAddrArray# barr# n# s#     of { (# s2#, r# #) ->
 135     (# s2#, A# r# #) }}
 136
 137 readFloatArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 138     case (index (l,u) n)                of { I# n# ->
 139     case readFloatArray# barr# n# s#    of { (# s2#, r# #) ->
 140     (# s2#, F# r# #) }}
 141
 142 readDoubleArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 143     case (index (l,u) n)                of { I# n# ->
 144     case readDoubleArray# barr# n# s#   of { (# s2#, r# #) ->
 145     (# s2#, D# r# #) }}
 146
 147 --Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
 148 indexCharArray   :: Ix ix => ByteArray ix -> ix -> Char
 149 indexIntArray    :: Ix ix => ByteArray ix -> ix -> Int
 150 indexWordArray   :: Ix ix => ByteArray ix -> ix -> Word
 151 indexAddrArray   :: Ix ix => ByteArray ix -> ix -> Addr
 152 indexFloatArray  :: Ix ix => ByteArray ix -> ix -> Float
 153 indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double
 154
 155 {-# SPECIALIZE indexCharArray   :: ByteArray Int -> Int -> Char #-}
 156 {-# SPECIALIZE indexIntArray    :: ByteArray Int -> Int -> Int #-}
 157 {-# SPECIALIZE indexAddrArray   :: ByteArray Int -> Int -> Addr #-}
 158 --NO:{-# SPECIALIZE indexFloatArray  :: ByteArray Int -> Int -> Float #-}
 159 {-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-}
 160
 161 indexCharArray (ByteArray l u barr#) n
 162   = case (index (l,u) n)                of { I# n# ->
 163     case indexCharArray# barr# n#       of { r# ->
 164     (C# r#)}}
 165
 166 indexIntArray (ByteArray l u barr#) n
 167   = case (index (l,u) n)                of { I# n# ->
 168     case indexIntArray# barr# n#        of { r# ->
 169     (I# r#)}}
 170
 171 indexWordArray (ByteArray l u barr#) n
 172   = case (index (l,u) n)                of { I# n# ->
 173     case indexWordArray# barr# n#       of { r# ->
 174     (W# r#)}}
 175
 176 indexAddrArray (ByteArray l u barr#) n
 177   = case (index (l,u) n)                of { I# n# ->
 178     case indexAddrArray# barr# n#       of { r# ->
 179     (A# r#)}}
 180
 181 indexFloatArray (ByteArray l u barr#) n
 182   = case (index (l,u) n)                of { I# n# ->
 183     case indexFloatArray# barr# n#      of { r# ->
 184     (F# r#)}}
 185
 186 indexDoubleArray (ByteArray l u barr#) n
 187   = case (index (l,u) n)                of { I# n# ->
 188     case indexDoubleArray# barr# n#     of { r# ->
 189     (D# r#)}}
 190
 191 writeCharArray   :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s ()
 192 writeIntArray    :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s ()
 193 writeWordArray   :: Ix ix => MutableByteArray s ix -> ix -> Word -> ST s ()
 194 writeAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s ()
 195 writeFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s ()
 196 writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s ()
 197
 198 {-# SPECIALIZE writeCharArray   :: MutableByteArray s Int -> Int -> Char -> ST s () #-}
 199 {-# SPECIALIZE writeIntArray    :: MutableByteArray s Int -> Int -> Int  -> ST s () #-}
 200 {-# SPECIALIZE writeAddrArray   :: MutableByteArray s Int -> Int -> Addr -> ST s () #-}
 201 --NO:{-# SPECIALIZE writeFloatArray  :: MutableByteArray s Int -> Int -> Float -> ST s () #-}
 202 {-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-}
 203
 204 writeCharArray (MutableByteArray l u barr#) n (C# ele) = ST $ \ s# ->
 205     case index (l,u) n                      of { I# n# ->
 206     case writeCharArray# barr# n# ele s#    of { s2#   ->
 207     (# s2#, () #) }}
 208
 209 writeIntArray (MutableByteArray l u barr#) n (I# ele) = ST $ \ s# ->
 210     case index (l,u) n                      of { I# n# ->
 211     case writeIntArray# barr# n# ele s#     of { s2#   ->
 212     (# s2#, () #) }}
 213
 214 writeWordArray (MutableByteArray l u barr#) n (W# ele) = ST $ \ s# ->
 215     case index (l,u) n                      of { I# n# ->
 216     case writeWordArray# barr# n# ele s#    of { s2#   ->
 217     (# s2#, () #) }}
 218
 219 writeAddrArray (MutableByteArray l u barr#) n (A# ele) = ST $ \ s# ->
 220     case index (l,u) n                      of { I# n# ->
 221     case writeAddrArray# barr# n# ele s#    of { s2#   ->
 222     (# s2#, () #) }}
 223
 224 writeFloatArray (MutableByteArray l u barr#) n (F# ele) = ST $ \ s# ->
 225     case index (l,u) n                      of { I# n# ->
 226     case writeFloatArray# barr# n# ele s#   of { s2#   ->
 227     (# s2#, () #) }}
 228
 229 writeDoubleArray (MutableByteArray l u barr#) n (D# ele) = ST $ \ s# ->
 230     case index (l,u) n                      of { I# n# ->
 231     case writeDoubleArray# barr# n# ele s#  of { s2#   ->
 232     (# s2#, () #) }}
 233 \end{code}
 234
 235
 236 %*********************************************************
 237 %*                                                      *
 238 \subsection{Moving between mutable and immutable}
 239 %*                                                      *
 240 %*********************************************************
 241
 242 \begin{code}
 243 freezeCharArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 244 freezeIntArray    :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 245 freezeWordArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 246 freezeAddrArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 247
 248 {-# SPECIALISE freezeCharArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
 249
 250 freezeCharArray (MutableByteArray l u arr#) = ST $ \ s# ->
 251     case rangeSize (l,u)     of { I# n# ->
 252     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 253     (# s2#, ByteArray l u frozen# #) }}
 254   where
 255     freeze  :: MutableByteArray# s      -- the thing
 256             -> Int#                     -- size of thing to be frozen
 257             -> State# s                 -- the Universe and everything
 258             -> (# State# s, ByteArray# #)
 259
 260     freeze arr1# n# s1#
 261       = case (newCharArray# n# s1#)         of { (# s2#, newarr1# #) ->
 262         case copy 0# n# arr1# newarr1# s2#  of { (# s3#, newarr2# #) ->
 263         unsafeFreezeByteArray# newarr2# s3#
 264         }}
 265       where
 266         copy :: Int# -> Int#
 267              -> MutableByteArray# s -> MutableByteArray# s
 268              -> State# s
 269              -> (# State# s, MutableByteArray# s #)
 270
 271         copy cur# end# from# to# st#
 272           | cur# ==# end#
 273             = (# st#, to# #)
 274           | otherwise
 275             = case (readCharArray#  from# cur#     st#) of { (# s2#, ele #) ->
 276               case (writeCharArray# to#   cur# ele s2#) of { s3# ->
 277               copy (cur# +# 1#) end# from# to# s3#
 278               }}
 279
 280 freezeIntArray (MutableByteArray l u arr#) = ST $ \ s# ->
 281     case rangeSize (l,u)     of { I# n# ->
 282     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 283     (# s2#, ByteArray l u frozen# #) }}
 284   where
 285     freeze  :: MutableByteArray# s      -- the thing
 286             -> Int#                     -- size of thing to be frozen
 287             -> State# s                 -- the Universe and everything
 288             -> (# State# s, ByteArray# #)
 289
 290     freeze m_arr# n# s#
 291       = case (newIntArray# n# s#)            of { (# s2#, newarr1# #) ->
 292         case copy 0# n# m_arr# newarr1# s2#  of { (# s3#, newarr2# #) ->
 293         unsafeFreezeByteArray# newarr2# s3#
 294         }}
 295       where
 296         copy :: Int# -> Int#
 297              -> MutableByteArray# s -> MutableByteArray# s
 298              -> State# s
 299              -> (# State# s, MutableByteArray# s #)
 300
 301         copy cur# end# from# to# s1#
 302           | cur# ==# end#
 303             = (# s1#, to# #)
 304           | otherwise
 305             = case (readIntArray#  from# cur#     s1#) of { (# s2#, ele #) ->
 306               case (writeIntArray# to#   cur# ele s2#) of { s3# ->
 307               copy (cur# +# 1#) end# from# to# s3#
 308               }}
 309
 310 freezeWordArray (MutableByteArray l u arr#) = ST $ \ s# ->
 311     case rangeSize (l,u)     of { I# n# ->
 312     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 313     (# s2#, ByteArray l u frozen# #) }}
 314   where
 315     freeze  :: MutableByteArray# s      -- the thing
 316             -> Int#                     -- size of thing to be frozen
 317             -> State# s                 -- the Universe and everything
 318             -> (# State# s, ByteArray# #)
 319
 320     freeze m_arr# n# s1#
 321       = case (newWordArray# n# s1#)          of { (# s2#, newarr1# #) ->
 322         case copy 0# n# m_arr# newarr1# s2#  of { (# s3#, newarr2# #) ->
 323         unsafeFreezeByteArray# newarr2# s3#
 324         }}
 325       where
 326         copy :: Int# -> Int#
 327              -> MutableByteArray# s -> MutableByteArray# s
 328              -> State# s
 329              -> (# State# s, MutableByteArray# s #)
 330
 331         copy cur# end# from# to# st#
 332           | cur# ==# end#  = (# st#, to# #)
 333           | otherwise      =
 334              case (readWordArray#  from# cur#     st#) of { (# s2#, ele #) ->
 335              case (writeWordArray# to#   cur# ele s2#) of { s3# ->
 336              copy (cur# +# 1#) end# from# to# s3#
 337              }}
 338
 339 freezeAddrArray (MutableByteArray l u arr#) = ST $ \ s# ->
 340     case rangeSize (l,u)     of { I# n# ->
 341     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 342     (# s2#, ByteArray l u frozen# #) }}
 343   where
 344     freeze  :: MutableByteArray# s      -- the thing
 345             -> Int#                     -- size of thing to be frozen
 346             -> State# s                 -- the Universe and everything
 347             -> (# State# s, ByteArray# #)
 348
 349     freeze m_arr# n# s1#
 350       = case (newAddrArray# n# s1#)          of { (# s2#, newarr1# #) ->
 351         case copy 0# n# m_arr# newarr1# s2#  of { (# s3#, newarr2# #) ->
 352         unsafeFreezeByteArray# newarr2# s3#
 353         }}
 354       where
 355         copy :: Int# -> Int#
 356              -> MutableByteArray# s -> MutableByteArray# s
 357              -> State# s
 358              -> (# State# s, MutableByteArray# s #)
 359
 360         copy cur# end# from# to# st#
 361           | cur# ==# end#
 362             = (# st#, to# #)
 363           | otherwise
 364             = case (readAddrArray#  from# cur#     st#)  of { (# st1#, ele #) ->
 365               case (writeAddrArray# to#   cur# ele st1#) of { st2# ->
 366               copy (cur# +# 1#) end# from# to# st2#
 367               }}
 368
 369 unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 370
 371 {-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
 372   #-}
 373
 374 unsafeFreezeByteArray (MutableByteArray l u arr#) = ST $ \ s# ->
 375     case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
 376     (# s2#, ByteArray l u frozen# #) }
 377 \end{code}