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