ghc/lib/std/PrelArr.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4 \section[PrelArr]{Module @PrelArr@}
   5
   6 Array implementation, @PrelArr@ exports the basic array
   7 types and operations.
   8
   9 \begin{code}
  10 {-# OPTIONS -fno-implicit-prelude #-}
  11
  12 module PrelArr where
  13
  14 import {-# SOURCE #-} PrelErr ( error )
  15 import Ix
  16 import PrelList (foldl)
  17 import PrelST
  18 import PrelBase
  19 import PrelCCall
  20 import PrelAddr
  21 import PrelGHC
  22
  23 infixl 9  !, //
  24 \end{code}
  25
  26 \begin{code}
  27 {-# SPECIALISE array :: (Int,Int) -> [(Int,b)] -> Array Int b #-}
  28 array                 :: (Ix a) => (a,a) -> [(a,b)] -> Array a b
  29
  30 {-# SPECIALISE (!) :: Array Int b -> Int -> b #-}
  31 (!)                   :: (Ix a) => Array a b -> a -> b
  32
  33 {-# SPECIALISE bounds :: Array Int b -> (Int,Int) #-}
  34 bounds                :: (Ix a) => Array a b -> (a,a)
  35
  36 {-# SPECIALISE (//) :: Array Int b -> [(Int,b)] -> Array Int b #-}
  37 (//)                  :: (Ix a) => Array a b -> [(a,b)] -> Array a b
  38
  39 {-# SPECIALISE accum  :: (b -> c -> b) -> Array Int b -> [(Int,c)] -> Array Int b #-}
  40 accum                 :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b
  41
  42 {-# SPECIALISE accumArray :: (b -> c -> b) -> b -> (Int,Int) -> [(Int,c)] -> Array Int b #-}
  43 accumArray            :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b
  44 \end{code}
  45
  46
  47 %*********************************************************
  48 %*                                                      *
  49 \subsection{The @Array@ types}
  50 %*                                                      *
  51 %*********************************************************
  52
  53 \begin{code}
  54 type IPr = (Int, Int)
  55
  56 data Ix ix => Array ix elt              = Array            (ix,ix) (Array# elt)
  57 data Ix ix => ByteArray ix              = ByteArray        (ix,ix) ByteArray#
  58 data Ix ix => MutableArray     s ix elt = MutableArray     (ix,ix) (MutableArray# s elt)
  59 data Ix ix => MutableByteArray s ix     = MutableByteArray (ix,ix) (MutableByteArray# s)
  60
  61 instance CCallable (MutableByteArray s ix)
  62 instance CCallable (MutableByteArray# s)
  63
  64 instance CCallable (ByteArray ix)
  65 instance CCallable ByteArray#
  66
  67 data MutableVar s a = MutableVar (MutVar# s a)
  68
  69 instance Eq (MutableVar s a) where
  70         MutableVar v1# == MutableVar v2#
  71                 = sameMutVar# v1# v2#
  72
  73 -- just pointer equality on arrays:
  74 instance Eq (MutableArray s ix elt) where
  75         MutableArray _ arr1# == MutableArray _ arr2#
  76                 = sameMutableArray# arr1# arr2#
  77
  78 instance Eq (MutableByteArray s ix) where
  79         MutableByteArray _ arr1# == MutableByteArray _ arr2#
  80                 = sameMutableByteArray# arr1# arr2#
  81 \end{code}
  82
  83 %*********************************************************
  84 %*                                                      *
  85 \subsection{Operations on mutable variables}
  86 %*                                                      *
  87 %*********************************************************
  88
  89 \begin{code}
  90 newVar   :: a -> ST s (MutableVar s a)
  91 readVar  :: MutableVar s a -> ST s a
  92 writeVar :: MutableVar s a -> a -> ST s ()
  93
  94 newVar init = ST $ \ s# ->
  95     case (newMutVar# init s#)     of { (# s2#, var# #) ->
  96     (# s2#, MutableVar var# #) }
  97
  98 readVar (MutableVar var#) = ST $ \ s# -> readMutVar# var# s#
  99
 100 writeVar (MutableVar var#) val = ST $ \ s# ->
 101     case writeMutVar# var# val s# of { s2# ->
 102     (# s2#, () #) }
 103 \end{code}
 104
 105 %*********************************************************
 106 %*                                                      *
 107 \subsection{Operations on immutable arrays}
 108 %*                                                      *
 109 %*********************************************************
 110
 111 "array", "!" and "bounds" are basic; the rest can be defined in terms of them
 112
 113 \begin{code}
 114 bounds (Array b _)  = b
 115
 116 (Array bounds arr#) ! i
 117   = let n# = case (index bounds i) of { I# x -> x } -- index fails if out of range
 118     in
 119     case (indexArray# arr# n#) of
 120       (# _, v #) -> v
 121
 122 #ifdef USE_FOLDR_BUILD
 123 {-# INLINE array #-}
 124 #endif
 125 array ixs ivs =
 126    runST ( ST $ \ s ->
 127         case (newArray ixs arrEleBottom)        of { ST new_array_thing ->
 128         case (new_array_thing s)                of { (# s#, arr@(MutableArray _ arr#) #) ->
 129         let
 130          fill_in s1# [] = s1#
 131          fill_in s1# ((i,v) : is) =
 132                 case (index ixs i)              of { I# n# ->
 133                 case writeArray# arr# n# v s1#  of { s2# ->
 134                 fill_in s2# is }}
 135         in
 136
 137         case (fill_in s# ivs)                   of { s1# ->
 138         case (freezeArray arr)                  of { ST freeze_array_thing ->
 139         freeze_array_thing s1# }}}})
 140
 141 arrEleBottom :: a
 142 arrEleBottom = error "(Array.!): undefined array element"
 143
 144 fill_it_in :: Ix ix => MutableArray s ix elt -> [(ix, elt)] -> ST s ()
 145 fill_it_in arr lst
 146   = foldr fill_one_in (return ()) lst
 147   where  -- **** STRICT **** (but that's OK...)
 148     fill_one_in (i, v) rst
 149       = writeArray arr i v >> rst
 150
 151 -----------------------------------------------------------------------
 152 -- these also go better with magic: (//), accum, accumArray
 153
 154 old_array // ivs
 155   = runST (do
 156         -- copy the old array:
 157         arr <- thawArray old_array
 158         -- now write the new elements into the new array:
 159         fill_it_in arr ivs
 160         freezeArray arr
 161     )
 162
 163 zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> MutableArray s ix elt -> [(ix,elt2)] -> ST s ()
 164 -- zap_with_f: reads an elem out first, then uses "f" on that and the new value
 165
 166 zap_with_f f arr lst
 167   = foldr zap_one (return ()) lst
 168   where
 169     zap_one (i, new_v) rst = do
 170         old_v <- readArray  arr i
 171         writeArray arr i (f old_v new_v)
 172         rst
 173
 174 accum f old_array ivs
 175   = runST (do
 176         -- copy the old array:
 177         arr <- thawArray old_array
 178         -- now zap the elements in question with "f":
 179         zap_with_f f arr ivs
 180         freezeArray arr
 181     )
 182
 183 accumArray f zero ixs ivs
 184   = runST (do
 185         arr# <- newArray ixs zero
 186         zap_with_f f  arr# ivs
 187         freezeArray arr#
 188     )
 189 \end{code}
 190
 191
 192 %*********************************************************
 193 %*                                                      *
 194 \subsection{Operations on mutable arrays}
 195 %*                                                      *
 196 %*********************************************************
 197
 198 Idle ADR question: What's the tradeoff here between flattening these
 199 datatypes into @MutableArray ix ix (MutableArray# s elt)@ and using
 200 it as is?  As I see it, the former uses slightly less heap and
 201 provides faster access to the individual parts of the bounds while the
 202 code used has the benefit of providing a ready-made @(lo, hi)@ pair as
 203 required by many array-related functions.  Which wins? Is the
 204 difference significant (probably not).
 205
 206 Idle AJG answer: When I looked at the outputted code (though it was 2
 207 years ago) it seems like you often needed the tuple, and we build
 208 it frequently. Now we've got the overloading specialiser things
 209 might be different, though.
 210
 211 \begin{code}
 212 newArray :: Ix ix => (ix,ix) -> elt -> ST s (MutableArray s ix elt)
 213 newCharArray, newIntArray, newWordArray, newAddrArray, newFloatArray, newDoubleArray
 214          :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
 215
 216 {-# SPECIALIZE newArray      :: IPr       -> elt -> ST s (MutableArray s Int elt),
 217                                 (IPr,IPr) -> elt -> ST s (MutableArray s IPr elt)
 218   #-}
 219 {-# SPECIALIZE newCharArray   :: IPr -> ST s (MutableByteArray s Int) #-}
 220 {-# SPECIALIZE newIntArray    :: IPr -> ST s (MutableByteArray s Int) #-}
 221 {-# SPECIALIZE newWordArray   :: IPr -> ST s (MutableByteArray s Int) #-}
 222 {-# SPECIALIZE newAddrArray   :: IPr -> ST s (MutableByteArray s Int) #-}
 223 {-# SPECIALIZE newFloatArray  :: IPr -> ST s (MutableByteArray s Int) #-}
 224 {-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-}
 225
 226 newArray ixs init = ST $ \ s# ->
 227     case rangeSize ixs              of { I# n# ->
 228     case (newArray# n# init s#)     of { (# s2#, arr# #) ->
 229     (# s2#, MutableArray ixs arr# #) }}
 230
 231 newCharArray ixs = ST $ \ s# ->
 232     case rangeSize ixs              of { I# n# ->
 233     case (newCharArray# n# s#)    of { (# s2#, barr# #) ->
 234     (# s2#, MutableByteArray ixs barr# #) }}
 235
 236 newIntArray ixs = ST $ \ s# ->
 237     case rangeSize ixs              of { I# n# ->
 238     case (newIntArray# n# s#)     of { (# s2#, barr# #) ->
 239     (# s2#, MutableByteArray ixs barr# #) }}
 240
 241 newWordArray ixs = ST $ \ s# ->
 242     case rangeSize ixs              of { I# n# ->
 243     case (newWordArray# n# s#)    of { (# s2#, barr# #) ->
 244     (# s2#, MutableByteArray ixs barr# #) }}
 245
 246 newAddrArray ixs = ST $ \ s# ->
 247     case rangeSize ixs              of { I# n# ->
 248     case (newAddrArray# n# s#)    of { (# s2#, barr# #) ->
 249     (# s2#, MutableByteArray ixs barr# #) }}
 250
 251 newFloatArray ixs = ST $ \ s# ->
 252     case rangeSize ixs              of { I# n# ->
 253     case (newFloatArray# n# s#)   of { (# s2#, barr# #) ->
 254     (# s2#, MutableByteArray ixs barr# #) }}
 255
 256 newDoubleArray ixs = ST $ \ s# ->
 257     case rangeSize ixs              of { I# n# ->
 258     case (newDoubleArray# n# s#)  of { (# s2#, barr# #) ->
 259     (# s2#, MutableByteArray ixs barr# #) }}
 260
 261 boundsOfArray     :: Ix ix => MutableArray s ix elt -> (ix, ix)
 262 boundsOfByteArray :: Ix ix => MutableByteArray s ix -> (ix, ix)
 263
 264 {-# SPECIALIZE boundsOfArray     :: MutableArray s Int elt -> IPr #-}
 265 {-# SPECIALIZE boundsOfByteArray :: MutableByteArray s Int -> IPr #-}
 266
 267 boundsOfArray     (MutableArray     ixs _) = ixs
 268 boundsOfByteArray (MutableByteArray ixs _) = ixs
 269
 270 readArray       :: Ix ix => MutableArray s ix elt -> ix -> ST s elt
 271
 272 readCharArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Char
 273 readIntArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
 274 readWordArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Word
 275 readAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr
 276 readFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
 277 readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
 278
 279 {-# SPECIALIZE readArray       :: MutableArray s Int elt -> Int -> ST s elt,
 280                                   MutableArray s IPr elt -> IPr -> ST s elt
 281   #-}
 282 {-# SPECIALIZE readCharArray   :: MutableByteArray s Int -> Int -> ST s Char #-}
 283 {-# SPECIALIZE readIntArray    :: MutableByteArray s Int -> Int -> ST s Int #-}
 284 {-# SPECIALIZE readAddrArray   :: MutableByteArray s Int -> Int -> ST s Addr #-}
 285 --NO:{-# SPECIALIZE readFloatArray  :: MutableByteArray s Int -> Int -> ST s Float #-}
 286 {-# SPECIALIZE readDoubleArray :: MutableByteArray s Int -> Int -> ST s Double #-}
 287
 288 readArray (MutableArray ixs arr#) n = ST $ \ s# ->
 289     case (index ixs n)          of { I# n# ->
 290     case readArray# arr# n# s#  of { (# s2#, r #) ->
 291     (# s2#, r #) }}
 292
 293 readCharArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 294     case (index ixs n)                  of { I# n# ->
 295     case readCharArray# barr# n# s#     of { (# s2#, r# #) ->
 296     (# s2#, C# r# #) }}
 297
 298 readIntArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 299     case (index ixs n)                  of { I# n# ->
 300     case readIntArray# barr# n# s#      of { (# s2#, r# #) ->
 301     (# s2#, I# r# #) }}
 302
 303 readWordArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 304     case (index ixs n)                  of { I# n# ->
 305     case readWordArray# barr# n# s#     of { (# s2#, r# #) ->
 306     (# s2#, W# r# #) }}
 307
 308 readAddrArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 309     case (index ixs n)                  of { I# n# ->
 310     case readAddrArray# barr# n# s#     of { (# s2#, r# #) ->
 311     (# s2#, A# r# #) }}
 312
 313 readFloatArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 314     case (index ixs n)                  of { I# n# ->
 315     case readFloatArray# barr# n# s#    of { (# s2#, r# #) ->
 316     (# s2#, F# r# #) }}
 317
 318 readDoubleArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 319     case (index ixs n)                  of { I# n# ->
 320     case readDoubleArray# barr# n# s#   of { (# s2#, r# #) ->
 321     (# s2#, D# r# #) }}
 322
 323 --Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
 324 indexCharArray   :: Ix ix => ByteArray ix -> ix -> Char
 325 indexIntArray    :: Ix ix => ByteArray ix -> ix -> Int
 326 indexWordArray   :: Ix ix => ByteArray ix -> ix -> Word
 327 indexAddrArray   :: Ix ix => ByteArray ix -> ix -> Addr
 328 indexFloatArray  :: Ix ix => ByteArray ix -> ix -> Float
 329 indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double
 330
 331 {-# SPECIALIZE indexCharArray   :: ByteArray Int -> Int -> Char #-}
 332 {-# SPECIALIZE indexIntArray    :: ByteArray Int -> Int -> Int #-}
 333 {-# SPECIALIZE indexAddrArray   :: ByteArray Int -> Int -> Addr #-}
 334 --NO:{-# SPECIALIZE indexFloatArray  :: ByteArray Int -> Int -> Float #-}
 335 {-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-}
 336
 337 indexCharArray (ByteArray ixs barr#) n
 338   = case (index ixs n)                  of { I# n# ->
 339     case indexCharArray# barr# n#       of { r# ->
 340     (C# r#)}}
 341
 342 indexIntArray (ByteArray ixs barr#) n
 343   = case (index ixs n)                  of { I# n# ->
 344     case indexIntArray# barr# n#        of { r# ->
 345     (I# r#)}}
 346
 347 indexWordArray (ByteArray ixs barr#) n
 348   = case (index ixs n)                  of { I# n# ->
 349     case indexWordArray# barr# n#       of { r# ->
 350     (W# r#)}}
 351
 352 indexAddrArray (ByteArray ixs barr#) n
 353   = case (index ixs n)                  of { I# n# ->
 354     case indexAddrArray# barr# n#       of { r# ->
 355     (A# r#)}}
 356
 357 indexFloatArray (ByteArray ixs barr#) n
 358   = case (index ixs n)                  of { I# n# ->
 359     case indexFloatArray# barr# n#      of { r# ->
 360     (F# r#)}}
 361
 362 indexDoubleArray (ByteArray ixs barr#) n
 363   = case (index ixs n)                  of { I# n# ->
 364     case indexDoubleArray# barr# n#     of { r# ->
 365     (D# r#)}}
 366
 367 writeArray       :: Ix ix => MutableArray s ix elt -> ix -> elt -> ST s ()
 368 writeCharArray   :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s ()
 369 writeIntArray    :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s ()
 370 writeWordArray   :: Ix ix => MutableByteArray s ix -> ix -> Word -> ST s ()
 371 writeAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s ()
 372 writeFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s ()
 373 writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s ()
 374
 375 {-# SPECIALIZE writeArray       :: MutableArray s Int elt -> Int -> elt -> ST s (),
 376                                    MutableArray s IPr elt -> IPr -> elt -> ST s ()
 377   #-}
 378 {-# SPECIALIZE writeCharArray   :: MutableByteArray s Int -> Int -> Char -> ST s () #-}
 379 {-# SPECIALIZE writeIntArray    :: MutableByteArray s Int -> Int -> Int  -> ST s () #-}
 380 {-# SPECIALIZE writeAddrArray   :: MutableByteArray s Int -> Int -> Addr -> ST s () #-}
 381 --NO:{-# SPECIALIZE writeFloatArray  :: MutableByteArray s Int -> Int -> Float -> ST s () #-}
 382 {-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-}
 383
 384 writeArray (MutableArray ixs arr#) n ele = ST $ \ s# ->
 385     case index ixs n                of { I# n# ->
 386     case writeArray# arr# n# ele s# of { s2# ->
 387     (# s2#, () #) }}
 388
 389 writeCharArray (MutableByteArray ixs barr#) n (C# ele) = ST $ \ s# ->
 390     case (index ixs n)                      of { I# n# ->
 391     case writeCharArray# barr# n# ele s#    of { s2#   ->
 392     (# s2#, () #) }}
 393
 394 writeIntArray (MutableByteArray ixs barr#) n (I# ele) = ST $ \ s# ->
 395     case (index ixs n)                      of { I# n# ->
 396     case writeIntArray# barr# n# ele s#     of { s2#   ->
 397     (# s2#, () #) }}
 398
 399 writeWordArray (MutableByteArray ixs barr#) n (W# ele) = ST $ \ s# ->
 400     case (index ixs n)                      of { I# n# ->
 401     case writeWordArray# barr# n# ele s#    of { s2#   ->
 402     (# s2#, () #) }}
 403
 404 writeAddrArray (MutableByteArray ixs barr#) n (A# ele) = ST $ \ s# ->
 405     case (index ixs n)                      of { I# n# ->
 406     case writeAddrArray# barr# n# ele s#    of { s2#   ->
 407     (# s2#, () #) }}
 408
 409 writeFloatArray (MutableByteArray ixs barr#) n (F# ele) = ST $ \ s# ->
 410     case (index ixs n)                      of { I# n# ->
 411     case writeFloatArray# barr# n# ele s#   of { s2#   ->
 412     (# s2#, () #) }}
 413
 414 writeDoubleArray (MutableByteArray ixs barr#) n (D# ele) = ST $ \ s# ->
 415     case (index ixs n)                      of { I# n# ->
 416     case writeDoubleArray# barr# n# ele s#  of { s2#   ->
 417     (# s2#, () #) }}
 418 \end{code}
 419
 420
 421 %*********************************************************
 422 %*                                                      *
 423 \subsection{Moving between mutable and immutable}
 424 %*                                                      *
 425 %*********************************************************
 426
 427 \begin{code}
 428 freezeArray       :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
 429 freezeCharArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 430 freezeIntArray    :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 431 freezeWordArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 432 freezeAddrArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 433
 434 {-# SPECIALISE freezeArray :: MutableArray s Int elt -> ST s (Array Int elt),
 435                               MutableArray s IPr elt -> ST s (Array IPr elt)
 436   #-}
 437 {-# SPECIALISE freezeCharArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
 438
 439 freezeArray (MutableArray ixs arr#) = ST $ \ s# ->
 440     case rangeSize ixs     of { I# n# ->
 441     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 442     (# s2#, Array ixs frozen# #) }}
 443   where
 444     freeze  :: MutableArray# s ele      -- the thing
 445             -> Int#                     -- size of thing to be frozen
 446             -> State# s                 -- the Universe and everything
 447             -> (# State# s, Array# ele #)
 448     freeze m_arr# n# s#
 449       = case newArray# n# init s#             of { (# s2#, newarr1# #) ->
 450         case copy 0# n# m_arr# newarr1# s2#   of { (# s3#, newarr2# #) ->
 451         unsafeFreezeArray# newarr2# s3#
 452         }}
 453       where
 454         init = error "freezeArray: element not copied"
 455
 456         copy :: Int# -> Int#
 457              -> MutableArray# s ele
 458              -> MutableArray# s ele
 459              -> State# s
 460              -> (# State# s, MutableArray# s ele #)
 461
 462         copy cur# end# from# to# st#
 463           | cur# ==# end#
 464             = (# st#, to# #)
 465           | otherwise
 466             = case readArray#  from# cur#     st#  of { (# s1#, ele #) ->
 467               case writeArray# to#   cur# ele s1# of { s2# ->
 468               copy (cur# +# 1#) end# from# to# s2#
 469               }}
 470
 471 freezeCharArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 472     case rangeSize ixs     of { I# n# ->
 473     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 474     (# s2#, ByteArray ixs frozen# #) }}
 475   where
 476     freeze  :: MutableByteArray# s      -- the thing
 477             -> Int#                     -- size of thing to be frozen
 478             -> State# s                 -- the Universe and everything
 479             -> (# State# s, ByteArray# #)
 480
 481     freeze arr1# n# s1#
 482       = case (newCharArray# n# s1#)         of { (# s2#, newarr1# #) ->
 483         case copy 0# n# arr1# newarr1# s2#  of { (# s3#, newarr2# #) ->
 484         unsafeFreezeByteArray# newarr2# s3#
 485         }}
 486       where
 487         copy :: Int# -> Int#
 488              -> MutableByteArray# s -> MutableByteArray# s
 489              -> State# s
 490              -> (# State# s, MutableByteArray# s #)
 491
 492         copy cur# end# from# to# st#
 493           | cur# ==# end#
 494             = (# st#, to# #)
 495           | otherwise
 496             = case (readCharArray#  from# cur#     st#) of { (# s2#, ele #) ->
 497               case (writeCharArray# to#   cur# ele s2#) of { s3# ->
 498               copy (cur# +# 1#) end# from# to# s3#
 499               }}
 500
 501 freezeIntArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 502     case rangeSize ixs     of { I# n# ->
 503     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 504     (# s2#, ByteArray ixs frozen# #) }}
 505   where
 506     freeze  :: MutableByteArray# s      -- the thing
 507             -> Int#                     -- size of thing to be frozen
 508             -> State# s                 -- the Universe and everything
 509             -> (# State# s, ByteArray# #)
 510
 511     freeze m_arr# n# s#
 512       = case (newIntArray# n# s#)            of { (# s2#, newarr1# #) ->
 513         case copy 0# n# m_arr# newarr1# s2#  of { (# s3#, newarr2# #) ->
 514         unsafeFreezeByteArray# newarr2# s3#
 515         }}
 516       where
 517         copy :: Int# -> Int#
 518              -> MutableByteArray# s -> MutableByteArray# s
 519              -> State# s
 520              -> (# State# s, MutableByteArray# s #)
 521
 522         copy cur# end# from# to# s1#
 523           | cur# ==# end#
 524             = (# s1#, to# #)
 525           | otherwise
 526             = case (readIntArray#  from# cur#     s1#) of { (# s2#, ele #) ->
 527               case (writeIntArray# to#   cur# ele s2#) of { s3# ->
 528               copy (cur# +# 1#) end# from# to# s3#
 529               }}
 530
 531 freezeWordArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 532     case rangeSize ixs     of { I# n# ->
 533     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 534     (# s2#, ByteArray ixs frozen# #) }}
 535   where
 536     freeze  :: MutableByteArray# s      -- the thing
 537             -> Int#                     -- size of thing to be frozen
 538             -> State# s                 -- the Universe and everything
 539             -> (# State# s, ByteArray# #)
 540
 541     freeze m_arr# n# s1#
 542       = case (newWordArray# n# s1#)          of { (# s2#, newarr1# #) ->
 543         case copy 0# n# m_arr# newarr1# s2#  of { (# s3#, newarr2# #) ->
 544         unsafeFreezeByteArray# newarr2# s3#
 545         }}
 546       where
 547         copy :: Int# -> Int#
 548              -> MutableByteArray# s -> MutableByteArray# s
 549              -> State# s
 550              -> (# State# s, MutableByteArray# s #)
 551
 552         copy cur# end# from# to# st#
 553           | cur# ==# end#  = (# st#, to# #)
 554           | otherwise      =
 555              case (readWordArray#  from# cur#     st#) of { (# s2#, ele #) ->
 556              case (writeWordArray# to#   cur# ele s2#) of { s3# ->
 557              copy (cur# +# 1#) end# from# to# s3#
 558              }}
 559
 560 freezeAddrArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 561     case rangeSize ixs     of { I# n# ->
 562     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 563     (# s2#, ByteArray ixs frozen# #) }}
 564   where
 565     freeze  :: MutableByteArray# s      -- the thing
 566             -> Int#                     -- size of thing to be frozen
 567             -> State# s                 -- the Universe and everything
 568             -> (# State# s, ByteArray# #)
 569
 570     freeze m_arr# n# s1#
 571       = case (newAddrArray# n# s1#)          of { (# s2#, newarr1# #) ->
 572         case copy 0# n# m_arr# newarr1# s2#  of { (# s3#, newarr2# #) ->
 573         unsafeFreezeByteArray# newarr2# s3#
 574         }}
 575       where
 576         copy :: Int# -> Int#
 577              -> MutableByteArray# s -> MutableByteArray# s
 578              -> State# s
 579              -> (# State# s, MutableByteArray# s #)
 580
 581         copy cur# end# from# to# st#
 582           | cur# ==# end#
 583             = (# st#, to# #)
 584           | otherwise
 585             = case (readAddrArray#  from# cur#     st#)  of { (# st1#, ele #) ->
 586               case (writeAddrArray# to#   cur# ele st1#) of { st2# ->
 587               copy (cur# +# 1#) end# from# to# st2#
 588               }}
 589
 590 unsafeFreezeArray     :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
 591 unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 592
 593 {-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
 594   #-}
 595
 596 unsafeFreezeArray (MutableArray ixs arr#) = ST $ \ s# ->
 597     case unsafeFreezeArray# arr# s# of { (# s2#, frozen# #) ->
 598     (# s2#, Array ixs frozen# #) }
 599
 600 unsafeFreezeByteArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 601     case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
 602     (# s2#, ByteArray ixs frozen# #) }
 603
 604
 605 --This takes a immutable array, and copies it into a mutable array, in a
 606 --hurry.
 607
 608 {-# SPECIALISE thawArray :: Array Int elt -> ST s (MutableArray s Int elt),
 609                             Array IPr elt -> ST s (MutableArray s IPr elt)
 610   #-}
 611
 612 thawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
 613 thawArray (Array ixs arr#) = ST $ \ s# ->
 614     case rangeSize ixs     of { I# n# ->
 615     case thaw arr# n# s# of { (# s2#, thawed# #) ->
 616     (# s2#, MutableArray ixs thawed# #)}}
 617   where
 618     thaw  :: Array# ele                 -- the thing
 619             -> Int#                     -- size of thing to be thawed
 620             -> State# s                 -- the Universe and everything
 621             -> (# State# s, MutableArray# s ele #)
 622
 623     thaw arr1# n# s#
 624       = case newArray# n# init s#             of { (# s2#, newarr1# #) ->
 625         copy 0# n# arr1# newarr1# s2# }
 626       where
 627         init = error "thawArray: element not copied"
 628
 629         copy :: Int# -> Int#
 630              -> Array# ele
 631              -> MutableArray# s ele
 632              -> State# s
 633              -> (# State# s, MutableArray# s ele #)
 634
 635         copy cur# end# from# to# st#
 636           | cur# ==# end#
 637             = (# st#, to# #)
 638           | otherwise
 639             = case indexArray#  from# cur#        of { (# _, ele #) ->
 640               case writeArray# to#   cur# ele st# of { s1# ->
 641               copy (cur# +# 1#) end# from# to# s1#
 642               }}
 643 \end{code}