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@(ix_start, ix_end) 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 s# [] = s#
 131          fill_in s# ((i,v):ivs) =
 132                 case (index ixs i)            of { I# n# ->
 133                 case writeArray# arr# n# v s# of { s2# ->
 134                 fill_in s2# ivs }}
 135         in
 136
 137         case (fill_in s# ivs)                   of { s# ->
 138         case (freezeArray arr)                  of { ST freeze_array_thing ->
 139         freeze_array_thing s# }}}})
 140
 141 arrEleBottom = error "(Array.!): undefined array element"
 142
 143 fill_it_in :: Ix ix => MutableArray s ix elt -> [(ix, elt)] -> ST s ()
 144 fill_it_in arr lst
 145   = foldr fill_one_in (return ()) lst
 146   where  -- **** STRICT **** (but that's OK...)
 147     fill_one_in (i, v) rst
 148       = writeArray arr i v >> rst
 149
 150 -----------------------------------------------------------------------
 151 -- these also go better with magic: (//), accum, accumArray
 152
 153 old_array // ivs
 154   = runST (do
 155         -- copy the old array:
 156         arr <- thawArray old_array
 157         -- now write the new elements into the new array:
 158         fill_it_in arr ivs
 159         freezeArray arr
 160     )
 161   where
 162     bottom = error "(Array.//): error in copying old array\n"
 163
 164 zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> MutableArray s ix elt -> [(ix,elt2)] -> ST s ()
 165 -- zap_with_f: reads an elem out first, then uses "f" on that and the new value
 166
 167 zap_with_f f arr lst
 168   = foldr zap_one (return ()) lst
 169   where
 170     zap_one (i, new_v) rst = do
 171         old_v <- readArray  arr i
 172         writeArray arr i (f old_v new_v)
 173         rst
 174
 175 accum f old_array ivs
 176   = runST (do
 177         -- copy the old array:
 178         arr <- thawArray old_array
 179         -- now zap the elements in question with "f":
 180         zap_with_f f arr ivs
 181         freezeArray arr
 182     )
 183   where
 184     bottom = error "Array.accum: error in copying old array\n"
 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, 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 boundsOfByteArray :: Ix ix => MutableByteArray s ix -> (ix, ix)
 266
 267 {-# SPECIALIZE boundsOfArray     :: MutableArray s Int elt -> IPr #-}
 268 {-# SPECIALIZE boundsOfByteArray :: MutableByteArray s Int -> IPr #-}
 269
 270 boundsOfArray     (MutableArray     ixs _) = ixs
 271 boundsOfByteArray (MutableByteArray ixs _) = ixs
 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 ixs arr#) n = ST $ \ s# ->
 292     case (index ixs n)          of { I# n# ->
 293     case readArray# arr# n# s#  of { (# s2#, r #) ->
 294     (# s2#, r #) }}
 295
 296 readCharArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 297     case (index ixs n)                  of { I# n# ->
 298     case readCharArray# barr# n# s#     of { (# s2#, r# #) ->
 299     (# s2#, C# r# #) }}
 300
 301 readIntArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 302     case (index ixs n)                  of { I# n# ->
 303     case readIntArray# barr# n# s#      of { (# s2#, r# #) ->
 304     (# s2#, I# r# #) }}
 305
 306 readWordArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 307     case (index ixs n)                  of { I# n# ->
 308     case readWordArray# barr# n# s#     of { (# s2#, r# #) ->
 309     (# s2#, W# r# #) }}
 310
 311 readAddrArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 312     case (index ixs n)                  of { I# n# ->
 313     case readAddrArray# barr# n# s#     of { (# s2#, r# #) ->
 314     (# s2#, A# r# #) }}
 315
 316 readFloatArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 317     case (index ixs n)                  of { I# n# ->
 318     case readFloatArray# barr# n# s#    of { (# s2#, r# #) ->
 319     (# s2#, F# r# #) }}
 320
 321 readDoubleArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 322     case (index ixs 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 ixs barr#) n
 341   = case (index ixs n)                  of { I# n# ->
 342     case indexCharArray# barr# n#       of { r# ->
 343     (C# r#)}}
 344
 345 indexIntArray (ByteArray ixs barr#) n
 346   = case (index ixs n)                  of { I# n# ->
 347     case indexIntArray# barr# n#        of { r# ->
 348     (I# r#)}}
 349
 350 indexWordArray (ByteArray ixs barr#) n
 351   = case (index ixs n)                  of { I# n# ->
 352     case indexWordArray# barr# n#       of { r# ->
 353     (W# r#)}}
 354
 355 indexAddrArray (ByteArray ixs barr#) n
 356   = case (index ixs n)                  of { I# n# ->
 357     case indexAddrArray# barr# n#       of { r# ->
 358     (A# r#)}}
 359
 360 indexFloatArray (ByteArray ixs barr#) n
 361   = case (index ixs n)                  of { I# n# ->
 362     case indexFloatArray# barr# n#      of { r# ->
 363     (F# r#)}}
 364
 365 indexDoubleArray (ByteArray ixs barr#) n
 366   = case (index ixs 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 ixs arr#) n ele = ST $ \ s# ->
 388     case index ixs n                of { I# n# ->
 389     case writeArray# arr# n# ele s# of { s2# ->
 390     (# s2#, () #) }}
 391
 392 writeCharArray (MutableByteArray ixs barr#) n (C# ele) = ST $ \ s# ->
 393     case (index ixs n)                      of { I# n# ->
 394     case writeCharArray# barr# n# ele s#    of { s2#   ->
 395     (# s2#, () #) }}
 396
 397 writeIntArray (MutableByteArray ixs barr#) n (I# ele) = ST $ \ s# ->
 398     case (index ixs n)                      of { I# n# ->
 399     case writeIntArray# barr# n# ele s#     of { s2#   ->
 400     (# s2#, () #) }}
 401
 402 writeWordArray (MutableByteArray ixs barr#) n (W# ele) = ST $ \ s# ->
 403     case (index ixs n)                      of { I# n# ->
 404     case writeWordArray# barr# n# ele s#    of { s2#   ->
 405     (# s2#, () #) }}
 406
 407 writeAddrArray (MutableByteArray ixs barr#) n (A# ele) = ST $ \ s# ->
 408     case (index ixs n)                      of { I# n# ->
 409     case writeAddrArray# barr# n# ele s#    of { s2#   ->
 410     (# s2#, () #) }}
 411
 412 writeFloatArray (MutableByteArray ixs barr#) n (F# ele) = ST $ \ s# ->
 413     case (index ixs n)                      of { I# n# ->
 414     case writeFloatArray# barr# n# ele s#   of { s2#   ->
 415     (# s2#, () #) }}
 416
 417 writeDoubleArray (MutableByteArray ixs barr#) n (D# ele) = ST $ \ s# ->
 418     case (index ixs 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 {-
 432 freezeArray       :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
 433 freezeCharArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 434 freezeIntArray    :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 435 freezeWordArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 436 freezeAddrArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 437
 438 {-# SPECIALISE freezeArray :: MutableArray s Int elt -> ST s (Array Int elt),
 439                               MutableArray s IPr elt -> ST s (Array IPr elt)
 440   #-}
 441 {-# SPECIALISE freezeCharArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
 442 -}
 443 freezeArray (MutableArray ixs arr#) = ST $ \ s# ->
 444     case rangeSize ixs     of { I# n# ->
 445     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 446     (# s2#, Array ixs frozen# #) }}
 447   where
 448     freeze  :: MutableArray# s ele      -- the thing
 449             -> Int#                     -- size of thing to be frozen
 450             -> State# s                 -- the Universe and everything
 451             -> (# State# s, Array# ele #)
 452     freeze arr# n# s#
 453       = case newArray# n# init s#             of { (# s2#, newarr1# #) ->
 454         case copy 0# n# arr# newarr1# s2#     of { (# s3#, newarr2# #) ->
 455         unsafeFreezeArray# newarr2# s3#
 456         }}
 457       where
 458         init = error "freezeArray: element not copied"
 459
 460         copy :: Int# -> Int#
 461              -> MutableArray# s ele
 462              -> MutableArray# s ele
 463              -> State# s
 464              -> (# State# s, MutableArray# s ele #)
 465
 466         copy cur# end# from# to# s#
 467           | cur# ==# end#
 468             = (# s#, to# #)
 469           | otherwise
 470             = case readArray#  from# cur#     s#  of { (# s1#, ele #) ->
 471               case writeArray# to#   cur# ele s1# of { s2# ->
 472               copy (cur# +# 1#) end# from# to# s2#
 473               }}
 474
 475 freezeCharArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 476     case rangeSize ixs     of { I# n# ->
 477     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 478     (# s2#, ByteArray ixs frozen# #) }}
 479   where
 480     freeze  :: MutableByteArray# s      -- the thing
 481             -> Int#                     -- size of thing to be frozen
 482             -> State# s                 -- the Universe and everything
 483             -> (# State# s, ByteArray# #)
 484
 485     freeze arr# n# s#
 486       = case (newCharArray# n# s#)         of { (# s2#, newarr1# #) ->
 487         case copy 0# n# arr# newarr1# s2#  of { (# s3#, newarr2# #) ->
 488         unsafeFreezeByteArray# newarr2# s3#
 489         }}
 490       where
 491         copy :: Int# -> Int#
 492              -> MutableByteArray# s -> MutableByteArray# s
 493              -> State# s
 494              -> (# State# s, MutableByteArray# s #)
 495
 496         copy cur# end# from# to# s#
 497           | cur# ==# end#
 498             = (# s#, to# #)
 499           | otherwise
 500             = case (readCharArray#  from# cur#     s#)  of { (# s1#, ele #) ->
 501               case (writeCharArray# to#   cur# ele s1#) of { s2# ->
 502               copy (cur# +# 1#) end# from# to# s2#
 503               }}
 504
 505 freezeIntArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 506     case rangeSize ixs     of { I# n# ->
 507     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 508     (# s2#, ByteArray ixs frozen# #) }}
 509   where
 510     freeze  :: MutableByteArray# s      -- the thing
 511             -> Int#                     -- size of thing to be frozen
 512             -> State# s                 -- the Universe and everything
 513             -> (# State# s, ByteArray# #)
 514
 515     freeze arr# n# s#
 516       = case (newIntArray# n# s#)          of { (# s2#, newarr1# #) ->
 517         case copy 0# n# arr# newarr1# s2#  of { (# s3#, newarr2# #) ->
 518         unsafeFreezeByteArray# newarr2# s3#
 519         }}
 520       where
 521         copy :: Int# -> Int#
 522              -> MutableByteArray# s -> MutableByteArray# s
 523              -> State# s
 524              -> (# State# s, MutableByteArray# s #)
 525
 526         copy cur# end# from# to# s#
 527           | cur# ==# end#
 528             = (# s#, to# #)
 529           | otherwise
 530             = case (readIntArray#  from# cur#     s#)  of { (# s1#, ele #) ->
 531               case (writeIntArray# to#   cur# ele s1#) of { s2# ->
 532               copy (cur# +# 1#) end# from# to# s2#
 533               }}
 534
 535 freezeWordArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 536     case rangeSize ixs     of { I# n# ->
 537     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 538     (# s2#, ByteArray ixs frozen# #) }}
 539   where
 540     freeze  :: MutableByteArray# s      -- the thing
 541             -> Int#                     -- size of thing to be frozen
 542             -> State# s                 -- the Universe and everything
 543             -> (# State# s, ByteArray# #)
 544
 545     freeze arr# n# s#
 546       = case (newWordArray# n# s#)         of { (# s2#, newarr1# #) ->
 547         case copy 0# n# arr# newarr1# s2#  of { (# s3#, newarr2# #) ->
 548         unsafeFreezeByteArray# newarr2# s3#
 549         }}
 550       where
 551         copy :: Int# -> Int#
 552              -> MutableByteArray# s -> MutableByteArray# s
 553              -> State# s
 554              -> (# State# s, MutableByteArray# s #)
 555
 556         copy cur# end# from# to# s#
 557           | cur# ==# end#
 558             = (# s#, to# #)
 559           | otherwise
 560             = case (readWordArray#  from# cur#     s#)  of { (# s1#, ele #) ->
 561               case (writeWordArray# to#   cur# ele s1#) of { s2# ->
 562               copy (cur# +# 1#) end# from# to# s2#
 563               }}
 564
 565 freezeAddrArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 566     case rangeSize ixs     of { I# n# ->
 567     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 568     (# s2#, ByteArray ixs frozen# #) }}
 569   where
 570     freeze  :: MutableByteArray# s      -- the thing
 571             -> Int#                     -- size of thing to be frozen
 572             -> State# s                 -- the Universe and everything
 573             -> (# State# s, ByteArray# #)
 574
 575     freeze arr# n# s#
 576       = case (newAddrArray# n# s#)         of { (# s2#, newarr1# #) ->
 577         case copy 0# n# arr# newarr1# s2#  of { (# s3#, newarr2# #) ->
 578         unsafeFreezeByteArray# newarr2# s3#
 579         }}
 580       where
 581         copy :: Int# -> Int#
 582              -> MutableByteArray# s -> MutableByteArray# s
 583              -> State# s
 584              -> (# State# s, MutableByteArray# s #)
 585
 586         copy cur# end# from# to# s#
 587           | cur# ==# end#
 588             = (# s#, to# #)
 589           | otherwise
 590             = case (readAddrArray#  from# cur#     s#)  of { (# s1#, ele #) ->
 591               case (writeAddrArray# to#   cur# ele s1#) of { s2# ->
 592               copy (cur# +# 1#) end# from# to# s2#
 593               }}
 594
 595 unsafeFreezeArray     :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
 596 unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 597
 598 {-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
 599   #-}
 600
 601 unsafeFreezeArray (MutableArray ixs arr#) = ST $ \ s# ->
 602     case unsafeFreezeArray# arr# s# of { (# s2#, frozen# #) ->
 603     (# s2#, Array ixs frozen# #) }
 604
 605 unsafeFreezeByteArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 606     case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
 607     (# s2#, ByteArray ixs frozen# #) }
 608
 609
 610 --This takes a immutable array, and copies it into a mutable array, in a
 611 --hurry.
 612
 613 {-# SPECIALISE thawArray :: Array Int elt -> ST s (MutableArray s Int elt),
 614                             Array IPr elt -> ST s (MutableArray s IPr elt)
 615   #-}
 616
 617 thawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
 618 thawArray (Array ixs arr#) = ST $ \ s# ->
 619     case rangeSize ixs     of { I# n# ->
 620     case thaw arr# n# s# of { (# s2#, thawed# #) ->
 621     (# s2#, MutableArray ixs thawed# #)}}
 622   where
 623     thaw  :: Array# ele                 -- the thing
 624             -> Int#                     -- size of thing to be thawed
 625             -> State# s                 -- the Universe and everything
 626             -> (# State# s, MutableArray# s ele #)
 627
 628     thaw arr# n# s#
 629       = case newArray# n# init s#             of { (# s2#, newarr1# #) ->
 630         copy 0# n# arr# newarr1# s2# }
 631       where
 632         init = error "thawArray: element not copied"
 633
 634         copy :: Int# -> Int#
 635              -> Array# ele
 636              -> MutableArray# s ele
 637              -> State# s
 638              -> (# State# s, MutableArray# s ele #)
 639
 640         copy cur# end# from# to# s#
 641           | cur# ==# end#
 642             = (# s#, to# #)
 643           | otherwise
 644             = case indexArray#  from# cur#       of { (# _, ele #) ->
 645               case writeArray# to#   cur# ele s# of { s1# ->
 646               copy (cur# +# 1#) end# from# to# s1#
 647               }}
 648
 649 \end{code}