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
 263 {-# SPECIALIZE boundsOfArray     :: MutableArray s Int elt -> IPr #-}
 264
 265 boundsOfArray     (MutableArray     ixs _) = ixs
 266
 267 readArray       :: Ix ix => MutableArray s ix elt -> ix -> ST s elt
 268
 269 readCharArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Char
 270 readIntArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
 271 readWordArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Word
 272 readAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr
 273 readFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
 274 readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
 275
 276 {-# SPECIALIZE readArray       :: MutableArray s Int elt -> Int -> ST s elt,
 277                                   MutableArray s IPr elt -> IPr -> ST s elt
 278   #-}
 279 {-# SPECIALIZE readCharArray   :: MutableByteArray s Int -> Int -> ST s Char #-}
 280 {-# SPECIALIZE readIntArray    :: MutableByteArray s Int -> Int -> ST s Int #-}
 281 {-# SPECIALIZE readAddrArray   :: MutableByteArray s Int -> Int -> ST s Addr #-}
 282 --NO:{-# SPECIALIZE readFloatArray  :: MutableByteArray s Int -> Int -> ST s Float #-}
 283 {-# SPECIALIZE readDoubleArray :: MutableByteArray s Int -> Int -> ST s Double #-}
 284
 285 readArray (MutableArray ixs arr#) n = ST $ \ s# ->
 286     case (index ixs n)          of { I# n# ->
 287     case readArray# arr# n# s#  of { (# s2#, r #) ->
 288     (# s2#, r #) }}
 289
 290 readCharArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 291     case (index ixs n)                  of { I# n# ->
 292     case readCharArray# barr# n# s#     of { (# s2#, r# #) ->
 293     (# s2#, C# r# #) }}
 294
 295 readIntArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 296     case (index ixs n)                  of { I# n# ->
 297     case readIntArray# barr# n# s#      of { (# s2#, r# #) ->
 298     (# s2#, I# r# #) }}
 299
 300 readWordArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 301     case (index ixs n)                  of { I# n# ->
 302     case readWordArray# barr# n# s#     of { (# s2#, r# #) ->
 303     (# s2#, W# r# #) }}
 304
 305 readAddrArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 306     case (index ixs n)                  of { I# n# ->
 307     case readAddrArray# barr# n# s#     of { (# s2#, r# #) ->
 308     (# s2#, A# r# #) }}
 309
 310 readFloatArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 311     case (index ixs n)                  of { I# n# ->
 312     case readFloatArray# barr# n# s#    of { (# s2#, r# #) ->
 313     (# s2#, F# r# #) }}
 314
 315 readDoubleArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 316     case (index ixs n)                  of { I# n# ->
 317     case readDoubleArray# barr# n# s#   of { (# s2#, r# #) ->
 318     (# s2#, D# r# #) }}
 319
 320 --Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
 321 indexCharArray   :: Ix ix => ByteArray ix -> ix -> Char
 322 indexIntArray    :: Ix ix => ByteArray ix -> ix -> Int
 323 indexWordArray   :: Ix ix => ByteArray ix -> ix -> Word
 324 indexAddrArray   :: Ix ix => ByteArray ix -> ix -> Addr
 325 indexFloatArray  :: Ix ix => ByteArray ix -> ix -> Float
 326 indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double
 327
 328 {-# SPECIALIZE indexCharArray   :: ByteArray Int -> Int -> Char #-}
 329 {-# SPECIALIZE indexIntArray    :: ByteArray Int -> Int -> Int #-}
 330 {-# SPECIALIZE indexAddrArray   :: ByteArray Int -> Int -> Addr #-}
 331 --NO:{-# SPECIALIZE indexFloatArray  :: ByteArray Int -> Int -> Float #-}
 332 {-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-}
 333
 334 indexCharArray (ByteArray ixs barr#) n
 335   = case (index ixs n)                  of { I# n# ->
 336     case indexCharArray# barr# n#       of { r# ->
 337     (C# r#)}}
 338
 339 indexIntArray (ByteArray ixs barr#) n
 340   = case (index ixs n)                  of { I# n# ->
 341     case indexIntArray# barr# n#        of { r# ->
 342     (I# r#)}}
 343
 344 indexWordArray (ByteArray ixs barr#) n
 345   = case (index ixs n)                  of { I# n# ->
 346     case indexWordArray# barr# n#       of { r# ->
 347     (W# r#)}}
 348
 349 indexAddrArray (ByteArray ixs barr#) n
 350   = case (index ixs n)                  of { I# n# ->
 351     case indexAddrArray# barr# n#       of { r# ->
 352     (A# r#)}}
 353
 354 indexFloatArray (ByteArray ixs barr#) n
 355   = case (index ixs n)                  of { I# n# ->
 356     case indexFloatArray# barr# n#      of { r# ->
 357     (F# r#)}}
 358
 359 indexDoubleArray (ByteArray ixs barr#) n
 360   = case (index ixs n)                  of { I# n# ->
 361     case indexDoubleArray# barr# n#     of { r# ->
 362     (D# r#)}}
 363
 364 writeArray       :: Ix ix => MutableArray s ix elt -> ix -> elt -> ST s ()
 365 writeCharArray   :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s ()
 366 writeIntArray    :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s ()
 367 writeWordArray   :: Ix ix => MutableByteArray s ix -> ix -> Word -> ST s ()
 368 writeAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s ()
 369 writeFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s ()
 370 writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s ()
 371
 372 {-# SPECIALIZE writeArray       :: MutableArray s Int elt -> Int -> elt -> ST s (),
 373                                    MutableArray s IPr elt -> IPr -> elt -> ST s ()
 374   #-}
 375 {-# SPECIALIZE writeCharArray   :: MutableByteArray s Int -> Int -> Char -> ST s () #-}
 376 {-# SPECIALIZE writeIntArray    :: MutableByteArray s Int -> Int -> Int  -> ST s () #-}
 377 {-# SPECIALIZE writeAddrArray   :: MutableByteArray s Int -> Int -> Addr -> ST s () #-}
 378 --NO:{-# SPECIALIZE writeFloatArray  :: MutableByteArray s Int -> Int -> Float -> ST s () #-}
 379 {-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-}
 380
 381 writeArray (MutableArray ixs arr#) n ele = ST $ \ s# ->
 382     case index ixs n                of { I# n# ->
 383     case writeArray# arr# n# ele s# of { s2# ->
 384     (# s2#, () #) }}
 385
 386 writeCharArray (MutableByteArray ixs barr#) n (C# ele) = ST $ \ s# ->
 387     case (index ixs n)                      of { I# n# ->
 388     case writeCharArray# barr# n# ele s#    of { s2#   ->
 389     (# s2#, () #) }}
 390
 391 writeIntArray (MutableByteArray ixs barr#) n (I# ele) = ST $ \ s# ->
 392     case (index ixs n)                      of { I# n# ->
 393     case writeIntArray# barr# n# ele s#     of { s2#   ->
 394     (# s2#, () #) }}
 395
 396 writeWordArray (MutableByteArray ixs barr#) n (W# ele) = ST $ \ s# ->
 397     case (index ixs n)                      of { I# n# ->
 398     case writeWordArray# barr# n# ele s#    of { s2#   ->
 399     (# s2#, () #) }}
 400
 401 writeAddrArray (MutableByteArray ixs barr#) n (A# ele) = ST $ \ s# ->
 402     case (index ixs n)                      of { I# n# ->
 403     case writeAddrArray# barr# n# ele s#    of { s2#   ->
 404     (# s2#, () #) }}
 405
 406 writeFloatArray (MutableByteArray ixs barr#) n (F# ele) = ST $ \ s# ->
 407     case (index ixs n)                      of { I# n# ->
 408     case writeFloatArray# barr# n# ele s#   of { s2#   ->
 409     (# s2#, () #) }}
 410
 411 writeDoubleArray (MutableByteArray ixs barr#) n (D# ele) = ST $ \ s# ->
 412     case (index ixs n)                      of { I# n# ->
 413     case writeDoubleArray# barr# n# ele s#  of { s2#   ->
 414     (# s2#, () #) }}
 415 \end{code}
 416
 417
 418 %*********************************************************
 419 %*                                                      *
 420 \subsection{Moving between mutable and immutable}
 421 %*                                                      *
 422 %*********************************************************
 423
 424 \begin{code}
 425 freezeArray       :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
 426 freezeCharArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 427 freezeIntArray    :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 428 freezeWordArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 429 freezeAddrArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 430
 431 {-# SPECIALISE freezeArray :: MutableArray s Int elt -> ST s (Array Int elt),
 432                               MutableArray s IPr elt -> ST s (Array IPr elt)
 433   #-}
 434 {-# SPECIALISE freezeCharArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
 435
 436 freezeArray (MutableArray ixs arr#) = ST $ \ s# ->
 437     case rangeSize ixs     of { I# n# ->
 438     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 439     (# s2#, Array ixs frozen# #) }}
 440   where
 441     freeze  :: MutableArray# s ele      -- the thing
 442             -> Int#                     -- size of thing to be frozen
 443             -> State# s                 -- the Universe and everything
 444             -> (# State# s, Array# ele #)
 445     freeze m_arr# n# s#
 446       = case newArray# n# init s#             of { (# s2#, newarr1# #) ->
 447         case copy 0# n# m_arr# newarr1# s2#   of { (# s3#, newarr2# #) ->
 448         unsafeFreezeArray# newarr2# s3#
 449         }}
 450       where
 451         init = error "freezeArray: element not copied"
 452
 453         copy :: Int# -> Int#
 454              -> MutableArray# s ele
 455              -> MutableArray# s ele
 456              -> State# s
 457              -> (# State# s, MutableArray# s ele #)
 458
 459         copy cur# end# from# to# st#
 460           | cur# ==# end#
 461             = (# st#, to# #)
 462           | otherwise
 463             = case readArray#  from# cur#     st#  of { (# s1#, ele #) ->
 464               case writeArray# to#   cur# ele s1# of { s2# ->
 465               copy (cur# +# 1#) end# from# to# s2#
 466               }}
 467
 468 freezeCharArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 469     case rangeSize ixs     of { I# n# ->
 470     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 471     (# s2#, ByteArray ixs frozen# #) }}
 472   where
 473     freeze  :: MutableByteArray# s      -- the thing
 474             -> Int#                     -- size of thing to be frozen
 475             -> State# s                 -- the Universe and everything
 476             -> (# State# s, ByteArray# #)
 477
 478     freeze arr1# n# s1#
 479       = case (newCharArray# n# s1#)         of { (# s2#, newarr1# #) ->
 480         case copy 0# n# arr1# newarr1# s2#  of { (# s3#, newarr2# #) ->
 481         unsafeFreezeByteArray# newarr2# s3#
 482         }}
 483       where
 484         copy :: Int# -> Int#
 485              -> MutableByteArray# s -> MutableByteArray# s
 486              -> State# s
 487              -> (# State# s, MutableByteArray# s #)
 488
 489         copy cur# end# from# to# st#
 490           | cur# ==# end#
 491             = (# st#, to# #)
 492           | otherwise
 493             = case (readCharArray#  from# cur#     st#) of { (# s2#, ele #) ->
 494               case (writeCharArray# to#   cur# ele s2#) of { s3# ->
 495               copy (cur# +# 1#) end# from# to# s3#
 496               }}
 497
 498 freezeIntArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 499     case rangeSize ixs     of { I# n# ->
 500     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 501     (# s2#, ByteArray ixs frozen# #) }}
 502   where
 503     freeze  :: MutableByteArray# s      -- the thing
 504             -> Int#                     -- size of thing to be frozen
 505             -> State# s                 -- the Universe and everything
 506             -> (# State# s, ByteArray# #)
 507
 508     freeze m_arr# n# s#
 509       = case (newIntArray# n# s#)            of { (# s2#, newarr1# #) ->
 510         case copy 0# n# m_arr# newarr1# s2#  of { (# s3#, newarr2# #) ->
 511         unsafeFreezeByteArray# newarr2# s3#
 512         }}
 513       where
 514         copy :: Int# -> Int#
 515              -> MutableByteArray# s -> MutableByteArray# s
 516              -> State# s
 517              -> (# State# s, MutableByteArray# s #)
 518
 519         copy cur# end# from# to# s1#
 520           | cur# ==# end#
 521             = (# s1#, to# #)
 522           | otherwise
 523             = case (readIntArray#  from# cur#     s1#) of { (# s2#, ele #) ->
 524               case (writeIntArray# to#   cur# ele s2#) of { s3# ->
 525               copy (cur# +# 1#) end# from# to# s3#
 526               }}
 527
 528 freezeWordArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 529     case rangeSize ixs     of { I# n# ->
 530     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 531     (# s2#, ByteArray ixs frozen# #) }}
 532   where
 533     freeze  :: MutableByteArray# s      -- the thing
 534             -> Int#                     -- size of thing to be frozen
 535             -> State# s                 -- the Universe and everything
 536             -> (# State# s, ByteArray# #)
 537
 538     freeze m_arr# n# s1#
 539       = case (newWordArray# n# s1#)          of { (# s2#, newarr1# #) ->
 540         case copy 0# n# m_arr# newarr1# s2#  of { (# s3#, newarr2# #) ->
 541         unsafeFreezeByteArray# newarr2# s3#
 542         }}
 543       where
 544         copy :: Int# -> Int#
 545              -> MutableByteArray# s -> MutableByteArray# s
 546              -> State# s
 547              -> (# State# s, MutableByteArray# s #)
 548
 549         copy cur# end# from# to# st#
 550           | cur# ==# end#  = (# st#, to# #)
 551           | otherwise      =
 552              case (readWordArray#  from# cur#     st#) of { (# s2#, ele #) ->
 553              case (writeWordArray# to#   cur# ele s2#) of { s3# ->
 554              copy (cur# +# 1#) end# from# to# s3#
 555              }}
 556
 557 freezeAddrArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 558     case rangeSize ixs     of { I# n# ->
 559     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 560     (# s2#, ByteArray ixs frozen# #) }}
 561   where
 562     freeze  :: MutableByteArray# s      -- the thing
 563             -> Int#                     -- size of thing to be frozen
 564             -> State# s                 -- the Universe and everything
 565             -> (# State# s, ByteArray# #)
 566
 567     freeze m_arr# n# s1#
 568       = case (newAddrArray# n# s1#)          of { (# s2#, newarr1# #) ->
 569         case copy 0# n# m_arr# newarr1# s2#  of { (# s3#, newarr2# #) ->
 570         unsafeFreezeByteArray# newarr2# s3#
 571         }}
 572       where
 573         copy :: Int# -> Int#
 574              -> MutableByteArray# s -> MutableByteArray# s
 575              -> State# s
 576              -> (# State# s, MutableByteArray# s #)
 577
 578         copy cur# end# from# to# st#
 579           | cur# ==# end#
 580             = (# st#, to# #)
 581           | otherwise
 582             = case (readAddrArray#  from# cur#     st#)  of { (# st1#, ele #) ->
 583               case (writeAddrArray# to#   cur# ele st1#) of { st2# ->
 584               copy (cur# +# 1#) end# from# to# st2#
 585               }}
 586
 587 unsafeFreezeArray     :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
 588 unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 589
 590 {-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
 591   #-}
 592
 593 unsafeFreezeArray (MutableArray ixs arr#) = ST $ \ s# ->
 594     case unsafeFreezeArray# arr# s# of { (# s2#, frozen# #) ->
 595     (# s2#, Array ixs frozen# #) }
 596
 597 unsafeFreezeByteArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 598     case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
 599     (# s2#, ByteArray ixs frozen# #) }
 600
 601
 602 --This takes a immutable array, and copies it into a mutable array, in a
 603 --hurry.
 604
 605 {-# SPECIALISE thawArray :: Array Int elt -> ST s (MutableArray s Int elt),
 606                             Array IPr elt -> ST s (MutableArray s IPr elt)
 607   #-}
 608
 609 thawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
 610 thawArray (Array ixs arr#) = ST $ \ s# ->
 611     case rangeSize ixs     of { I# n# ->
 612     case thaw arr# n# s# of { (# s2#, thawed# #) ->
 613     (# s2#, MutableArray ixs thawed# #)}}
 614   where
 615     thaw  :: Array# ele                 -- the thing
 616             -> Int#                     -- size of thing to be thawed
 617             -> State# s                 -- the Universe and everything
 618             -> (# State# s, MutableArray# s ele #)
 619
 620     thaw arr1# n# s#
 621       = case newArray# n# init s#             of { (# s2#, newarr1# #) ->
 622         copy 0# n# arr1# newarr1# s2# }
 623       where
 624         init = error "thawArray: element not copied"
 625
 626         copy :: Int# -> Int#
 627              -> Array# ele
 628              -> MutableArray# s ele
 629              -> State# s
 630              -> (# State# s, MutableArray# s ele #)
 631
 632         copy cur# end# from# to# st#
 633           | cur# ==# end#
 634             = (# st#, to# #)
 635           | otherwise
 636             = case indexArray#  from# cur#        of { (# _, ele #) ->
 637               case writeArray# to#   cur# ele st# of { s1# ->
 638               copy (cur# +# 1#) end# from# to# s1#
 639               }}
 640
 641 -- this is a quicker version of the above, just flipping the type
 642 -- (& representation) of an immutable array. And placing a
 643 -- proof obligation on the programmer.
 644 unsafeThawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
 645 unsafeThawArray (Array ixs arr#) = ST $ \ s# ->
 646    case unsafeThawArray# arr# s# of
 647       (# s2#, marr# #) -> (# s2#, MutableArray ixs marr# #)
 648 \end{code}