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 (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, newWordArray, newAddrArray, 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 newWordArray   :: IPr -> ST s (MutableByteArray s Int) #-}
  73 {-# SPECIALIZE newAddrArray   :: IPr -> ST s (MutableByteArray s Int) #-}
  74 {-# SPECIALIZE newFloatArray  :: IPr -> ST s (MutableByteArray s Int) #-}
  75 {-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-}
  76
  77 newCharArray (l,u) = ST $ \ s# ->
  78     case rangeSize (l,u)          of { I# n# ->
  79     case (newCharArray# n# s#)    of { (# s2#, barr# #) ->
  80     (# s2#, MutableByteArray l u barr# #) }}
  81
  82 newIntArray (l,u) = ST $ \ s# ->
  83     case rangeSize (l,u)          of { I# n# ->
  84     case (newIntArray# n# s#)     of { (# s2#, barr# #) ->
  85     (# s2#, MutableByteArray l u barr# #) }}
  86
  87 newWordArray (l,u) = ST $ \ s# ->
  88     case rangeSize (l,u)          of { I# n# ->
  89     case (newWordArray# n# s#)    of { (# s2#, barr# #) ->
  90     (# s2#, MutableByteArray l u barr# #) }}
  91
  92 newAddrArray (l,u) = ST $ \ s# ->
  93     case rangeSize (l,u)          of { I# n# ->
  94     case (newAddrArray# n# s#)    of { (# s2#, barr# #) ->
  95     (# s2#, MutableByteArray l u barr# #) }}
  96
  97 newFloatArray (l,u) = ST $ \ s# ->
  98     case rangeSize (l,u)          of { I# n# ->
  99     case (newFloatArray# n# s#)   of { (# s2#, barr# #) ->
 100     (# s2#, MutableByteArray l u barr# #) }}
 101
 102 newDoubleArray (l,u) = ST $ \ s# ->
 103     case rangeSize (l,u)          of { I# n# ->
 104     case (newDoubleArray# n# s#)  of { (# s2#, barr# #) ->
 105     (# s2#, MutableByteArray l u barr# #) }}
 106
 107
 108 readCharArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Char
 109 readIntArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
 110 readWordArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Word
 111 readAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr
 112 readFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
 113 readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
 114
 115 {-# SPECIALIZE readCharArray   :: MutableByteArray s Int -> Int -> ST s Char #-}
 116 {-# SPECIALIZE readIntArray    :: MutableByteArray s Int -> Int -> ST s Int #-}
 117 {-# SPECIALIZE readAddrArray   :: MutableByteArray s Int -> Int -> ST s Addr #-}
 118 --NO:{-# SPECIALIZE readFloatArray  :: MutableByteArray s Int -> Int -> ST s Float #-}
 119 {-# SPECIALIZE readDoubleArray :: MutableByteArray s Int -> Int -> ST s Double #-}
 120
 121 readCharArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 122     case (index (l,u) n)                of { I# n# ->
 123     case readCharArray# barr# n# s#     of { (# s2#, r# #) ->
 124     (# s2#, C# r# #) }}
 125
 126 readIntArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 127     case (index (l,u) n)                of { I# n# ->
 128     case readIntArray# barr# n# s#      of { (# s2#, r# #) ->
 129     (# s2#, I# r# #) }}
 130
 131 readWordArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 132     case (index (l,u) n)                of { I# n# ->
 133     case readWordArray# barr# n# s#     of { (# s2#, r# #) ->
 134     (# s2#, W# r# #) }}
 135
 136 readAddrArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 137     case (index (l,u) n)                of { I# n# ->
 138     case readAddrArray# barr# n# s#     of { (# s2#, r# #) ->
 139     (# s2#, A# r# #) }}
 140
 141 readFloatArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 142     case (index (l,u) n)                of { I# n# ->
 143     case readFloatArray# barr# n# s#    of { (# s2#, r# #) ->
 144     (# s2#, F# r# #) }}
 145
 146 readDoubleArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 147     case (index (l,u) n)                of { I# n# ->
 148     case readDoubleArray# barr# n# s#   of { (# s2#, r# #) ->
 149     (# s2#, D# r# #) }}
 150
 151 --Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
 152 indexCharArray   :: Ix ix => ByteArray ix -> ix -> Char
 153 indexIntArray    :: Ix ix => ByteArray ix -> ix -> Int
 154 indexWordArray   :: Ix ix => ByteArray ix -> ix -> Word
 155 indexAddrArray   :: Ix ix => ByteArray ix -> ix -> Addr
 156 indexFloatArray  :: Ix ix => ByteArray ix -> ix -> Float
 157 indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double
 158
 159 {-# SPECIALIZE indexCharArray   :: ByteArray Int -> Int -> Char #-}
 160 {-# SPECIALIZE indexIntArray    :: ByteArray Int -> Int -> Int #-}
 161 {-# SPECIALIZE indexAddrArray   :: ByteArray Int -> Int -> Addr #-}
 162 --NO:{-# SPECIALIZE indexFloatArray  :: ByteArray Int -> Int -> Float #-}
 163 {-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-}
 164
 165 indexCharArray (ByteArray l u barr#) n
 166   = case (index (l,u) n)                of { I# n# ->
 167     case indexCharArray# barr# n#       of { r# ->
 168     (C# r#)}}
 169
 170 indexIntArray (ByteArray l u barr#) n
 171   = case (index (l,u) n)                of { I# n# ->
 172     case indexIntArray# barr# n#        of { r# ->
 173     (I# r#)}}
 174
 175 indexWordArray (ByteArray l u barr#) n
 176   = case (index (l,u) n)                of { I# n# ->
 177     case indexWordArray# barr# n#       of { r# ->
 178     (W# r#)}}
 179
 180 indexAddrArray (ByteArray l u barr#) n
 181   = case (index (l,u) n)                of { I# n# ->
 182     case indexAddrArray# barr# n#       of { r# ->
 183     (A# r#)}}
 184
 185 indexFloatArray (ByteArray l u barr#) n
 186   = case (index (l,u) n)                of { I# n# ->
 187     case indexFloatArray# barr# n#      of { r# ->
 188     (F# r#)}}
 189
 190 indexDoubleArray (ByteArray l u barr#) n
 191   = case (index (l,u) n)                of { I# n# ->
 192     case indexDoubleArray# barr# n#     of { r# ->
 193     (D# r#)}}
 194
 195 writeCharArray   :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s ()
 196 writeIntArray    :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s ()
 197 writeWordArray   :: Ix ix => MutableByteArray s ix -> ix -> Word -> ST s ()
 198 writeAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s ()
 199 writeFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s ()
 200 writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s ()
 201
 202 {-# SPECIALIZE writeCharArray   :: MutableByteArray s Int -> Int -> Char -> ST s () #-}
 203 {-# SPECIALIZE writeIntArray    :: MutableByteArray s Int -> Int -> Int  -> ST s () #-}
 204 {-# SPECIALIZE writeAddrArray   :: MutableByteArray s Int -> Int -> Addr -> ST s () #-}
 205 --NO:{-# SPECIALIZE writeFloatArray  :: MutableByteArray s Int -> Int -> Float -> ST s () #-}
 206 {-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-}
 207
 208 writeCharArray (MutableByteArray l u barr#) n (C# ele) = ST $ \ s# ->
 209     case index (l,u) n                      of { I# n# ->
 210     case writeCharArray# barr# n# ele s#    of { s2#   ->
 211     (# s2#, () #) }}
 212
 213 writeIntArray (MutableByteArray l u barr#) n (I# ele) = ST $ \ s# ->
 214     case index (l,u) n                      of { I# n# ->
 215     case writeIntArray# barr# n# ele s#     of { s2#   ->
 216     (# s2#, () #) }}
 217
 218 writeWordArray (MutableByteArray l u barr#) n (W# ele) = ST $ \ s# ->
 219     case index (l,u) n                      of { I# n# ->
 220     case writeWordArray# barr# n# ele s#    of { s2#   ->
 221     (# s2#, () #) }}
 222
 223 writeAddrArray (MutableByteArray l u barr#) n (A# ele) = ST $ \ s# ->
 224     case index (l,u) n                      of { I# n# ->
 225     case writeAddrArray# barr# n# ele s#    of { s2#   ->
 226     (# s2#, () #) }}
 227
 228 writeFloatArray (MutableByteArray l u barr#) n (F# ele) = ST $ \ s# ->
 229     case index (l,u) n                      of { I# n# ->
 230     case writeFloatArray# barr# n# ele s#   of { s2#   ->
 231     (# s2#, () #) }}
 232
 233 writeDoubleArray (MutableByteArray l u barr#) n (D# ele) = ST $ \ s# ->
 234     case index (l,u) n                      of { I# n# ->
 235     case writeDoubleArray# barr# n# ele s#  of { s2#   ->
 236     (# s2#, () #) }}
 237 \end{code}
 238
 239
 240 %*********************************************************
 241 %*                                                      *
 242 \subsection{Moving between mutable and immutable}
 243 %*                                                      *
 244 %*********************************************************
 245
 246 \begin{code}
 247 freezeCharArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 248 freezeIntArray    :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 249 freezeWordArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 250 freezeAddrArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 251
 252 {-# SPECIALISE freezeCharArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
 253
 254 freezeCharArray (MutableByteArray l u arr#) = ST $ \ s# ->
 255     case rangeSize (l,u)     of { I# n# ->
 256     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 257     (# s2#, ByteArray l u frozen# #) }}
 258   where
 259     freeze  :: MutableByteArray# s      -- the thing
 260             -> Int#                     -- size of thing to be frozen
 261             -> State# s                 -- the Universe and everything
 262             -> (# State# s, ByteArray# #)
 263
 264     freeze arr1# n# s1#
 265       = case (newCharArray# n# s1#)         of { (# s2#, newarr1# #) ->
 266         case copy 0# n# arr1# newarr1# s2#  of { (# s3#, newarr2# #) ->
 267         unsafeFreezeByteArray# newarr2# s3#
 268         }}
 269       where
 270         copy :: Int# -> Int#
 271              -> MutableByteArray# s -> MutableByteArray# s
 272              -> State# s
 273              -> (# State# s, MutableByteArray# s #)
 274
 275         copy cur# end# from# to# st#
 276           | cur# ==# end#
 277             = (# st#, to# #)
 278           | otherwise
 279             = case (readCharArray#  from# cur#     st#) of { (# s2#, ele #) ->
 280               case (writeCharArray# to#   cur# ele s2#) of { s3# ->
 281               copy (cur# +# 1#) end# from# to# s3#
 282               }}
 283
 284 freezeIntArray (MutableByteArray l u arr#) = ST $ \ s# ->
 285     case rangeSize (l,u)     of { I# n# ->
 286     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 287     (# s2#, ByteArray l u frozen# #) }}
 288   where
 289     freeze  :: MutableByteArray# s      -- the thing
 290             -> Int#                     -- size of thing to be frozen
 291             -> State# s                 -- the Universe and everything
 292             -> (# State# s, ByteArray# #)
 293
 294     freeze m_arr# n# s#
 295       = case (newIntArray# n# s#)            of { (# s2#, newarr1# #) ->
 296         case copy 0# n# m_arr# newarr1# s2#  of { (# s3#, newarr2# #) ->
 297         unsafeFreezeByteArray# newarr2# s3#
 298         }}
 299       where
 300         copy :: Int# -> Int#
 301              -> MutableByteArray# s -> MutableByteArray# s
 302              -> State# s
 303              -> (# State# s, MutableByteArray# s #)
 304
 305         copy cur# end# from# to# s1#
 306           | cur# ==# end#
 307             = (# s1#, to# #)
 308           | otherwise
 309             = case (readIntArray#  from# cur#     s1#) of { (# s2#, ele #) ->
 310               case (writeIntArray# to#   cur# ele s2#) of { s3# ->
 311               copy (cur# +# 1#) end# from# to# s3#
 312               }}
 313
 314 freezeWordArray (MutableByteArray l u arr#) = ST $ \ s# ->
 315     case rangeSize (l,u)     of { I# n# ->
 316     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 317     (# s2#, ByteArray l u frozen# #) }}
 318   where
 319     freeze  :: MutableByteArray# s      -- the thing
 320             -> Int#                     -- size of thing to be frozen
 321             -> State# s                 -- the Universe and everything
 322             -> (# State# s, ByteArray# #)
 323
 324     freeze m_arr# n# s1#
 325       = case (newWordArray# n# s1#)          of { (# s2#, newarr1# #) ->
 326         case copy 0# n# m_arr# newarr1# s2#  of { (# s3#, newarr2# #) ->
 327         unsafeFreezeByteArray# newarr2# s3#
 328         }}
 329       where
 330         copy :: Int# -> Int#
 331              -> MutableByteArray# s -> MutableByteArray# s
 332              -> State# s
 333              -> (# State# s, MutableByteArray# s #)
 334
 335         copy cur# end# from# to# st#
 336           | cur# ==# end#  = (# st#, to# #)
 337           | otherwise      =
 338              case (readWordArray#  from# cur#     st#) of { (# s2#, ele #) ->
 339              case (writeWordArray# to#   cur# ele s2#) of { s3# ->
 340              copy (cur# +# 1#) end# from# to# s3#
 341              }}
 342
 343 freezeAddrArray (MutableByteArray l u arr#) = ST $ \ s# ->
 344     case rangeSize (l,u)     of { I# n# ->
 345     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 346     (# s2#, ByteArray l u frozen# #) }}
 347   where
 348     freeze  :: MutableByteArray# s      -- the thing
 349             -> Int#                     -- size of thing to be frozen
 350             -> State# s                 -- the Universe and everything
 351             -> (# State# s, ByteArray# #)
 352
 353     freeze m_arr# n# s1#
 354       = case (newAddrArray# n# s1#)          of { (# s2#, newarr1# #) ->
 355         case copy 0# n# m_arr# newarr1# s2#  of { (# s3#, newarr2# #) ->
 356         unsafeFreezeByteArray# newarr2# s3#
 357         }}
 358       where
 359         copy :: Int# -> Int#
 360              -> MutableByteArray# s -> MutableByteArray# s
 361              -> State# s
 362              -> (# State# s, MutableByteArray# s #)
 363
 364         copy cur# end# from# to# st#
 365           | cur# ==# end#
 366             = (# st#, to# #)
 367           | otherwise
 368             = case (readAddrArray#  from# cur#     st#)  of { (# st1#, ele #) ->
 369               case (writeAddrArray# to#   cur# ele st1#) of { st2# ->
 370               copy (cur# +# 1#) end# from# to# st2#
 371               }}
 372
 373 unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 374
 375 {-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
 376   #-}
 377
 378 unsafeFreezeByteArray (MutableByteArray l u arr#) = ST $ \ s# ->
 379     case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
 380     (# s2#, ByteArray l u frozen# #) }
 381 \end{code}