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 {-# INLINE array #-}
 123 array ixs ivs
 124   = case rangeSize ixs                          of { I# n ->
 125     runST ( ST $ \ s1 ->
 126         case newArray# n arrEleBottom s1        of { (# s2, marr #) ->
 127         foldr (fill ixs marr) (done ixs marr) ivs s2
 128     })}
 129
 130 fill :: Ix ix => (ix,ix)  -> MutableArray# s elt
 131               -> (ix,elt) -> STRep s a -> STRep s a
 132 {-# INLINE fill #-}
 133 fill ixs marr (i,v) next = \s1 -> case index ixs i      of { I# n ->
 134                                   case writeArray# marr n v s1  of { s2 ->
 135                                   next s2 }}
 136
 137 done :: Ix ix => (ix,ix) -> MutableArray# s elt
 138               -> STRep s (Array ix elt)
 139 {-# INLINE done #-}
 140 done ixs marr = \s1 -> case unsafeFreezeArray# marr s1          of { (# s2, arr #) ->
 141                        (# s2, Array ixs arr #) }
 142
 143 arrEleBottom :: a
 144 arrEleBottom = error "(Array.!): undefined array element"
 145
 146
 147 -----------------------------------------------------------------------
 148 -- these also go better with magic: (//), accum, accumArray
 149
 150 old_array // ivs
 151   = runST (do
 152         -- copy the old array:
 153         arr <- thawArray old_array
 154         -- now write the new elements into the new array:
 155         fill_it_in arr ivs
 156         freezeArray arr
 157     )
 158
 159 fill_it_in :: Ix ix => MutableArray s ix elt -> [(ix, elt)] -> ST s ()
 160 fill_it_in arr lst
 161   = foldr fill_one_in (return ()) lst
 162   where  -- **** STRICT **** (but that's OK...)
 163     fill_one_in (i, v) rst
 164       = writeArray arr i v >> rst
 165
 166 zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> MutableArray s ix elt -> [(ix,elt2)] -> ST s ()
 167 -- zap_with_f: reads an elem out first, then uses "f" on that and the new value
 168
 169 zap_with_f f arr lst
 170   = foldr zap_one (return ()) lst
 171   where
 172     zap_one (i, new_v) rst = do
 173         old_v <- readArray  arr i
 174         writeArray arr i (f old_v new_v)
 175         rst
 176
 177 accum f old_array ivs
 178   = runST (do
 179         -- copy the old array:
 180         arr <- thawArray old_array
 181         -- now zap the elements in question with "f":
 182         zap_with_f f arr ivs
 183         freezeArray arr
 184     )
 185
 186 accumArray f zero ixs ivs
 187   = runST (do
 188         arr# <- newArray ixs zero
 189         zap_with_f f  arr# ivs
 190         freezeArray arr#
 191     )
 192 \end{code}
 193
 194
 195 %*********************************************************
 196 %*                                                      *
 197 \subsection{Operations on mutable arrays}
 198 %*                                                      *
 199 %*********************************************************
 200
 201 Idle ADR question: What's the tradeoff here between flattening these
 202 datatypes into @MutableArray ix ix (MutableArray# s elt)@ and using
 203 it as is?  As I see it, the former uses slightly less heap and
 204 provides faster access to the individual parts of the bounds while the
 205 code used has the benefit of providing a ready-made @(lo, hi)@ pair as
 206 required by many array-related functions.  Which wins? Is the
 207 difference significant (probably not).
 208
 209 Idle AJG answer: When I looked at the outputted code (though it was 2
 210 years ago) it seems like you often needed the tuple, and we build
 211 it frequently. Now we've got the overloading specialiser things
 212 might be different, though.
 213
 214 \begin{code}
 215 newArray :: Ix ix => (ix,ix) -> elt -> ST s (MutableArray s ix elt)
 216 newCharArray, newIntArray, newWordArray, newAddrArray, newFloatArray, newDoubleArray
 217          :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
 218
 219 {-# SPECIALIZE newArray      :: IPr       -> elt -> ST s (MutableArray s Int elt),
 220                                 (IPr,IPr) -> elt -> ST s (MutableArray s IPr elt)
 221   #-}
 222 {-# SPECIALIZE newCharArray   :: IPr -> ST s (MutableByteArray s Int) #-}
 223 {-# SPECIALIZE newIntArray    :: IPr -> ST s (MutableByteArray s Int) #-}
 224 {-# SPECIALIZE newWordArray   :: IPr -> ST s (MutableByteArray s Int) #-}
 225 {-# SPECIALIZE newAddrArray   :: IPr -> ST s (MutableByteArray s Int) #-}
 226 {-# SPECIALIZE newFloatArray  :: IPr -> ST s (MutableByteArray s Int) #-}
 227 {-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-}
 228
 229 newArray ixs init = ST $ \ s# ->
 230     case rangeSize ixs              of { I# n# ->
 231     case (newArray# n# init s#)     of { (# s2#, arr# #) ->
 232     (# s2#, MutableArray ixs arr# #) }}
 233
 234 newCharArray ixs = ST $ \ s# ->
 235     case rangeSize ixs              of { I# n# ->
 236     case (newCharArray# n# s#)    of { (# s2#, barr# #) ->
 237     (# s2#, MutableByteArray ixs barr# #) }}
 238
 239 newIntArray ixs = ST $ \ s# ->
 240     case rangeSize ixs              of { I# n# ->
 241     case (newIntArray# n# s#)     of { (# s2#, barr# #) ->
 242     (# s2#, MutableByteArray ixs barr# #) }}
 243
 244 newWordArray ixs = ST $ \ s# ->
 245     case rangeSize ixs              of { I# n# ->
 246     case (newWordArray# n# s#)    of { (# s2#, barr# #) ->
 247     (# s2#, MutableByteArray ixs barr# #) }}
 248
 249 newAddrArray ixs = ST $ \ s# ->
 250     case rangeSize ixs              of { I# n# ->
 251     case (newAddrArray# n# s#)    of { (# s2#, barr# #) ->
 252     (# s2#, MutableByteArray ixs barr# #) }}
 253
 254 newFloatArray ixs = ST $ \ s# ->
 255     case rangeSize ixs              of { I# n# ->
 256     case (newFloatArray# n# s#)   of { (# s2#, barr# #) ->
 257     (# s2#, MutableByteArray ixs barr# #) }}
 258
 259 newDoubleArray ixs = ST $ \ s# ->
 260     case rangeSize ixs              of { I# n# ->
 261     case (newDoubleArray# n# s#)  of { (# s2#, barr# #) ->
 262     (# s2#, MutableByteArray ixs barr# #) }}
 263
 264 boundsOfArray     :: Ix ix => MutableArray s ix elt -> (ix, ix)
 265
 266 {-# SPECIALIZE boundsOfArray     :: MutableArray s Int elt -> IPr #-}
 267
 268 boundsOfArray     (MutableArray     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
 644 -- this is a quicker version of the above, just flipping the type
 645 -- (& representation) of an immutable array. And placing a
 646 -- proof obligation on the programmer.
 647 unsafeThawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
 648 unsafeThawArray (Array ixs arr#) = ST $ \ s# ->
 649    case unsafeThawArray# arr# s# of
 650       (# s2#, marr# #) -> (# s2#, MutableArray ixs marr# #)
 651 \end{code}