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 -- A one-element mutable array:
  68 type MutableVar s a = MutableArray s Int a
  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 (newArray# 1# init s#)     of { StateAndMutableArray# s2# arr# ->
  93     STret s2# (MutableArray vAR_IXS arr#) }
  94   where
  95     vAR_IXS = error "newVar: Shouldn't access `bounds' of a MutableVar\n"
  96
  97 readVar (MutableArray _ var#) = ST $ \ s# ->
  98     case readArray# var# 0# s#  of { StateAndPtr# s2# r ->
  99     STret s2# r }
 100
 101 writeVar (MutableArray _ var#) val = ST $ \ s# ->
 102     case writeArray# var# 0# val s# of { s2# ->
 103     STret s2# () }
 104 \end{code}
 105
 106 %*********************************************************
 107 %*                                                      *
 108 \subsection{Operations on immutable arrays}
 109 %*                                                      *
 110 %*********************************************************
 111
 112 "array", "!" and "bounds" are basic; the rest can be defined in terms of them
 113
 114 \begin{code}
 115 bounds (Array b _)  = b
 116
 117 (Array bounds arr#) ! i
 118   = let n# = case (index bounds i) of { I# x -> x } -- index fails if out of range
 119     in
 120     case (indexArray# arr# n#) of
 121       Lift v -> v
 122
 123 #ifdef USE_FOLDR_BUILD
 124 {-# INLINE array #-}
 125 #endif
 126 array ixs@(ix_start, ix_end) ivs =
 127    runST ( ST $ \ s ->
 128         case (newArray ixs arrEleBottom)        of { ST new_array_thing ->
 129         case (new_array_thing s)                of { STret s# arr@(MutableArray _ arr#) ->
 130         let
 131          fill_in s# [] = s#
 132          fill_in s# ((i,v):ivs) =
 133                 case (index ixs i)            of { I# n# ->
 134                 case writeArray# arr# n# v s# of { s2# ->
 135                 fill_in s2# ivs }}
 136         in
 137
 138         case (fill_in s# ivs)                   of { s# ->
 139         case (freezeArray arr)                  of { ST freeze_array_thing ->
 140         freeze_array_thing s# }}}})
 141
 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   where
 163     bottom = error "(Array.//): error in copying old array\n"
 164
 165 zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> MutableArray s ix elt -> [(ix,elt2)] -> ST s ()
 166 -- zap_with_f: reads an elem out first, then uses "f" on that and the new value
 167
 168 zap_with_f f arr lst
 169   = foldr zap_one (return ()) lst
 170   where
 171     zap_one (i, new_v) rst = do
 172         old_v <- readArray  arr i
 173         writeArray arr i (f old_v new_v)
 174         rst
 175
 176 accum f old_array ivs
 177   = runST (do
 178         -- copy the old array:
 179         arr <- thawArray old_array
 180         -- now zap the elements in question with "f":
 181         zap_with_f f arr ivs
 182         freezeArray arr
 183     )
 184   where
 185     bottom = error "Array.accum: error in copying old array\n"
 186
 187 accumArray f zero ixs ivs
 188   = runST (do
 189         arr# <- newArray ixs zero
 190         zap_with_f f  arr# ivs
 191         freezeArray arr#
 192     )
 193 \end{code}
 194
 195
 196 %*********************************************************
 197 %*                                                      *
 198 \subsection{Operations on mutable arrays}
 199 %*                                                      *
 200 %*********************************************************
 201
 202 Idle ADR question: What's the tradeoff here between flattening these
 203 datatypes into @MutableArray ix ix (MutableArray# s elt)@ and using
 204 it as is?  As I see it, the former uses slightly less heap and
 205 provides faster access to the individual parts of the bounds while the
 206 code used has the benefit of providing a ready-made @(lo, hi)@ pair as
 207 required by many array-related functions.  Which wins? Is the
 208 difference significant (probably not).
 209
 210 Idle AJG answer: When I looked at the outputted code (though it was 2
 211 years ago) it seems like you often needed the tuple, and we build
 212 it frequently. Now we've got the overloading specialiser things
 213 might be different, though.
 214
 215 \begin{code}
 216 newArray :: Ix ix => (ix,ix) -> elt -> ST s (MutableArray s ix elt)
 217 newCharArray, newIntArray, newAddrArray, newFloatArray, newDoubleArray
 218          :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
 219
 220 {-# SPECIALIZE newArray      :: IPr       -> elt -> ST s (MutableArray s Int elt),
 221                                 (IPr,IPr) -> elt -> ST s (MutableArray s IPr elt)
 222   #-}
 223 {-# SPECIALIZE newCharArray   :: IPr -> ST s (MutableByteArray s Int) #-}
 224 {-# SPECIALIZE newIntArray    :: IPr -> ST s (MutableByteArray s Int) #-}
 225 {-# SPECIALIZE newWordArray   :: IPr -> ST s (MutableByteArray s Int) #-}
 226 {-# SPECIALIZE newAddrArray   :: IPr -> ST s (MutableByteArray s Int) #-}
 227 {-# SPECIALIZE newFloatArray  :: IPr -> ST s (MutableByteArray s Int) #-}
 228 {-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-}
 229
 230 newArray ixs init = ST $ \ s# ->
 231     case rangeSize ixs              of { I# n# ->
 232     case (newArray# n# init s#)     of { StateAndMutableArray# s2# arr# ->
 233     STret s2# (MutableArray ixs arr#) }}
 234
 235 newCharArray ixs = ST $ \ s# ->
 236     case rangeSize ixs              of { I# n# ->
 237     case (newCharArray# n# s#)    of { StateAndMutableByteArray# s2# barr# ->
 238     STret s2# (MutableByteArray ixs barr#) }}
 239
 240 newIntArray ixs = ST $ \ s# ->
 241     case rangeSize ixs              of { I# n# ->
 242     case (newIntArray# n# s#)     of { StateAndMutableByteArray# s2# barr# ->
 243     STret s2# (MutableByteArray ixs barr#) }}
 244
 245 newWordArray ixs = ST $ \ s# ->
 246     case rangeSize ixs              of { I# n# ->
 247     case (newWordArray# n# s#)    of { StateAndMutableByteArray# s2# barr# ->
 248     STret s2# (MutableByteArray ixs barr#) }}
 249
 250 newAddrArray ixs = ST $ \ s# ->
 251     case rangeSize ixs              of { I# n# ->
 252     case (newAddrArray# n# s#)    of { StateAndMutableByteArray# s2# barr# ->
 253     STret s2# (MutableByteArray ixs barr#) }}
 254
 255 newFloatArray ixs = ST $ \ s# ->
 256     case rangeSize ixs              of { I# n# ->
 257     case (newFloatArray# n# s#)   of { StateAndMutableByteArray# s2# barr# ->
 258     STret s2# (MutableByteArray ixs barr#) }}
 259
 260 newDoubleArray ixs = ST $ \ s# ->
 261     case rangeSize ixs              of { I# n# ->
 262     case (newDoubleArray# n# s#)  of { StateAndMutableByteArray# s2# barr# ->
 263     STret s2# (MutableByteArray ixs barr#) }}
 264
 265 boundsOfArray     :: Ix ix => MutableArray s ix elt -> (ix, ix)
 266 boundsOfByteArray :: Ix ix => MutableByteArray s ix -> (ix, ix)
 267
 268 {-# SPECIALIZE boundsOfArray     :: MutableArray s Int elt -> IPr #-}
 269 {-# SPECIALIZE boundsOfByteArray :: MutableByteArray s Int -> IPr #-}
 270
 271 boundsOfArray     (MutableArray     ixs _) = ixs
 272 boundsOfByteArray (MutableByteArray ixs _) = ixs
 273
 274 readArray       :: Ix ix => MutableArray s ix elt -> ix -> ST s elt
 275
 276 readCharArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Char
 277 readIntArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
 278 readWordArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Word
 279 readAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr
 280 readFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
 281 readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
 282
 283 {-# SPECIALIZE readArray       :: MutableArray s Int elt -> Int -> ST s elt,
 284                                   MutableArray s IPr elt -> IPr -> ST s elt
 285   #-}
 286 {-# SPECIALIZE readCharArray   :: MutableByteArray s Int -> Int -> ST s Char #-}
 287 {-# SPECIALIZE readIntArray    :: MutableByteArray s Int -> Int -> ST s Int #-}
 288 {-# SPECIALIZE readAddrArray   :: MutableByteArray s Int -> Int -> ST s Addr #-}
 289 --NO:{-# SPECIALIZE readFloatArray  :: MutableByteArray s Int -> Int -> ST s Float #-}
 290 {-# SPECIALIZE readDoubleArray :: MutableByteArray s Int -> Int -> ST s Double #-}
 291
 292 readArray (MutableArray ixs arr#) n = ST $ \ s# ->
 293     case (index ixs n)          of { I# n# ->
 294     case readArray# arr# n# s#  of { StateAndPtr# s2# r ->
 295     STret s2# r }}
 296
 297 readCharArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 298     case (index ixs n)                  of { I# n# ->
 299     case readCharArray# barr# n# s#     of { StateAndChar# s2# r# ->
 300     STret s2# (C# r#) }}
 301
 302 readIntArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 303     case (index ixs n)                  of { I# n# ->
 304     case readIntArray# barr# n# s#      of { StateAndInt# s2# r# ->
 305     STret s2# (I# r#) }}
 306
 307 readWordArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 308     case (index ixs n)                  of { I# n# ->
 309     case readWordArray# barr# n# s#     of { StateAndWord# s2# r# ->
 310     STret s2# (W# r#) }}
 311
 312 readAddrArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 313     case (index ixs n)                  of { I# n# ->
 314     case readAddrArray# barr# n# s#     of { StateAndAddr# s2# r# ->
 315     STret s2# (A# r#) }}
 316
 317 readFloatArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 318     case (index ixs n)                  of { I# n# ->
 319     case readFloatArray# barr# n# s#    of { StateAndFloat# s2# r# ->
 320     STret s2# (F# r#) }}
 321
 322 readDoubleArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 323     case (index ixs n)                  of { I# n# ->
 324     case readDoubleArray# barr# n# s#   of { StateAndDouble# s2# r# ->
 325     STret s2# (D# r#) }}
 326
 327 --Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
 328 indexCharArray   :: Ix ix => ByteArray ix -> ix -> Char
 329 indexIntArray    :: Ix ix => ByteArray ix -> ix -> Int
 330 indexWordArray   :: Ix ix => ByteArray ix -> ix -> Word
 331 indexAddrArray   :: Ix ix => ByteArray ix -> ix -> Addr
 332 indexFloatArray  :: Ix ix => ByteArray ix -> ix -> Float
 333 indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double
 334
 335 {-# SPECIALIZE indexCharArray   :: ByteArray Int -> Int -> Char #-}
 336 {-# SPECIALIZE indexIntArray    :: ByteArray Int -> Int -> Int #-}
 337 {-# SPECIALIZE indexAddrArray   :: ByteArray Int -> Int -> Addr #-}
 338 --NO:{-# SPECIALIZE indexFloatArray  :: ByteArray Int -> Int -> Float #-}
 339 {-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-}
 340
 341 indexCharArray (ByteArray ixs barr#) n
 342   = case (index ixs n)                  of { I# n# ->
 343     case indexCharArray# barr# n#       of { r# ->
 344     (C# r#)}}
 345
 346 indexIntArray (ByteArray ixs barr#) n
 347   = case (index ixs n)                  of { I# n# ->
 348     case indexIntArray# barr# n#        of { r# ->
 349     (I# r#)}}
 350
 351 indexWordArray (ByteArray ixs barr#) n
 352   = case (index ixs n)                  of { I# n# ->
 353     case indexWordArray# barr# n#       of { r# ->
 354     (W# r#)}}
 355
 356 indexAddrArray (ByteArray ixs barr#) n
 357   = case (index ixs n)                  of { I# n# ->
 358     case indexAddrArray# barr# n#       of { r# ->
 359     (A# r#)}}
 360
 361 indexFloatArray (ByteArray ixs barr#) n
 362   = case (index ixs n)                  of { I# n# ->
 363     case indexFloatArray# barr# n#      of { r# ->
 364     (F# r#)}}
 365
 366 indexDoubleArray (ByteArray ixs barr#) n
 367   = case (index ixs n)                  of { I# n# ->
 368     case indexDoubleArray# barr# n#     of { r# ->
 369     (D# r#)}}
 370
 371 writeArray       :: Ix ix => MutableArray s ix elt -> ix -> elt -> ST s ()
 372 writeCharArray   :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s ()
 373 writeIntArray    :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s ()
 374 writeWordArray   :: Ix ix => MutableByteArray s ix -> ix -> Word -> ST s ()
 375 writeAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s ()
 376 writeFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s ()
 377 writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s ()
 378
 379 {-# SPECIALIZE writeArray       :: MutableArray s Int elt -> Int -> elt -> ST s (),
 380                                    MutableArray s IPr elt -> IPr -> elt -> ST s ()
 381   #-}
 382 {-# SPECIALIZE writeCharArray   :: MutableByteArray s Int -> Int -> Char -> ST s () #-}
 383 {-# SPECIALIZE writeIntArray    :: MutableByteArray s Int -> Int -> Int  -> ST s () #-}
 384 {-# SPECIALIZE writeAddrArray   :: MutableByteArray s Int -> Int -> Addr -> ST s () #-}
 385 --NO:{-# SPECIALIZE writeFloatArray  :: MutableByteArray s Int -> Int -> Float -> ST s () #-}
 386 {-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-}
 387
 388 writeArray (MutableArray ixs arr#) n ele = ST $ \ s# ->
 389     case index ixs n                of { I# n# ->
 390     case writeArray# arr# n# ele s# of { s2# ->
 391     STret s2# () }}
 392
 393 writeCharArray (MutableByteArray ixs barr#) n (C# ele) = ST $ \ s# ->
 394     case (index ixs n)                      of { I# n# ->
 395     case writeCharArray# barr# n# ele s#    of { s2#   ->
 396     STret s2# () }}
 397
 398 writeIntArray (MutableByteArray ixs barr#) n (I# ele) = ST $ \ s# ->
 399     case (index ixs n)                      of { I# n# ->
 400     case writeIntArray# barr# n# ele s#     of { s2#   ->
 401     STret s2# () }}
 402
 403 writeWordArray (MutableByteArray ixs barr#) n (W# ele) = ST $ \ s# ->
 404     case (index ixs n)                      of { I# n# ->
 405     case writeWordArray# barr# n# ele s#    of { s2#   ->
 406     STret s2# () }}
 407
 408 writeAddrArray (MutableByteArray ixs barr#) n (A# ele) = ST $ \ s# ->
 409     case (index ixs n)                      of { I# n# ->
 410     case writeAddrArray# barr# n# ele s#    of { s2#   ->
 411     STret s2# () }}
 412
 413 writeFloatArray (MutableByteArray ixs barr#) n (F# ele) = ST $ \ s# ->
 414     case (index ixs n)                      of { I# n# ->
 415     case writeFloatArray# barr# n# ele s#   of { s2#   ->
 416     STret s2# () }}
 417
 418 writeDoubleArray (MutableByteArray ixs barr#) n (D# ele) = ST $ \ s# ->
 419     case (index ixs n)                      of { I# n# ->
 420     case writeDoubleArray# barr# n# ele s#  of { s2#   ->
 421     STret s2# () }}
 422 \end{code}
 423
 424
 425 %*********************************************************
 426 %*                                                      *
 427 \subsection{Moving between mutable and immutable}
 428 %*                                                      *
 429 %*********************************************************
 430
 431 \begin{code}
 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 freezeFloatArray  :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 438 freezeDoubleArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 439
 440 {-# SPECIALISE freezeArray :: MutableArray s Int elt -> ST s (Array Int elt),
 441                               MutableArray s IPr elt -> ST s (Array IPr elt)
 442   #-}
 443 {-# SPECIALISE freezeCharArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
 444
 445 freezeArray (MutableArray ixs arr#) = ST $ \ s# ->
 446     case rangeSize ixs     of { I# n# ->
 447     case freeze arr# n# s# of { StateAndArray# s2# frozen# ->
 448     STret s2# (Array ixs frozen#) }}
 449   where
 450     freeze  :: MutableArray# s ele      -- the thing
 451             -> Int#                     -- size of thing to be frozen
 452             -> State# s                 -- the Universe and everything
 453             -> StateAndArray# s ele
 454
 455     freeze arr# n# s#
 456       = case newArray# n# init s#             of { StateAndMutableArray# s2# newarr1# ->
 457         case copy 0# n# arr# newarr1# s2#     of { StateAndMutableArray# s3# newarr2# ->
 458         unsafeFreezeArray# newarr2# s3#
 459         }}
 460       where
 461         init = error "freezeArray: element not copied"
 462
 463         copy :: Int# -> Int#
 464              -> MutableArray# s ele -> MutableArray# s ele
 465              -> State# s
 466              -> StateAndMutableArray# s ele
 467
 468         copy cur# end# from# to# s#
 469           | cur# ==# end#
 470             = StateAndMutableArray# s# to#
 471           | otherwise
 472             = case readArray#  from# cur#     s#  of { StateAndPtr# s1# ele ->
 473               case writeArray# to#   cur# ele s1# of { s2# ->
 474               copy (cur# +# 1#) end# from# to# s2#
 475               }}
 476
 477 freezeCharArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 478     case rangeSize ixs     of { I# n# ->
 479     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 480     STret s2# (ByteArray ixs frozen#) }}
 481   where
 482     freeze  :: MutableByteArray# s      -- the thing
 483             -> Int#                     -- size of thing to be frozen
 484             -> State# s                 -- the Universe and everything
 485             -> StateAndByteArray# s
 486
 487     freeze arr# n# s#
 488       = case (newCharArray# n# s#)         of { StateAndMutableByteArray# s2# newarr1# ->
 489         case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
 490         unsafeFreezeByteArray# newarr2# s3#
 491         }}
 492       where
 493         copy :: Int# -> Int#
 494              -> MutableByteArray# s -> MutableByteArray# s
 495              -> State# s
 496              -> StateAndMutableByteArray# s
 497
 498         copy cur# end# from# to# s#
 499           | cur# ==# end#
 500             = StateAndMutableByteArray# s# to#
 501           | otherwise
 502             = case (readCharArray#  from# cur#     s#)  of { StateAndChar# s1# ele ->
 503               case (writeCharArray# to#   cur# ele s1#) of { s2# ->
 504               copy (cur# +# 1#) end# from# to# s2#
 505               }}
 506
 507 freezeIntArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 508     case rangeSize ixs     of { I# n# ->
 509     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 510     STret s2# (ByteArray ixs frozen#) }}
 511   where
 512     freeze  :: MutableByteArray# s      -- the thing
 513             -> Int#                     -- size of thing to be frozen
 514             -> State# s                 -- the Universe and everything
 515             -> StateAndByteArray# s
 516
 517     freeze arr# n# s#
 518       = case (newIntArray# n# s#)          of { StateAndMutableByteArray# s2# newarr1# ->
 519         case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
 520         unsafeFreezeByteArray# newarr2# s3#
 521         }}
 522       where
 523         copy :: Int# -> Int#
 524              -> MutableByteArray# s -> MutableByteArray# s
 525              -> State# s
 526              -> StateAndMutableByteArray# s
 527
 528         copy cur# end# from# to# s#
 529           | cur# ==# end#
 530             = StateAndMutableByteArray# s# to#
 531           | otherwise
 532             = case (readIntArray#  from# cur#     s#)  of { StateAndInt# s1# ele ->
 533               case (writeIntArray# to#   cur# ele s1#) of { s2# ->
 534               copy (cur# +# 1#) end# from# to# s2#
 535               }}
 536
 537 freezeWordArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 538     case rangeSize ixs     of { I# n# ->
 539     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 540     STret s2# (ByteArray ixs frozen#) }}
 541   where
 542     freeze  :: MutableByteArray# s      -- the thing
 543             -> Int#                     -- size of thing to be frozen
 544             -> State# s                 -- the Universe and everything
 545             -> StateAndByteArray# s
 546
 547     freeze arr# n# s#
 548       = case (newWordArray# n# s#)         of { StateAndMutableByteArray# s2# newarr1# ->
 549         case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
 550         unsafeFreezeByteArray# newarr2# s3#
 551         }}
 552       where
 553         copy :: Int# -> Int#
 554              -> MutableByteArray# s -> MutableByteArray# s
 555              -> State# s
 556              -> StateAndMutableByteArray# s
 557
 558         copy cur# end# from# to# s#
 559           | cur# ==# end#
 560             = StateAndMutableByteArray# s# to#
 561           | otherwise
 562             = case (readWordArray#  from# cur#     s#)  of { StateAndWord# s1# ele ->
 563               case (writeWordArray# to#   cur# ele s1#) of { s2# ->
 564               copy (cur# +# 1#) end# from# to# s2#
 565               }}
 566
 567 freezeAddrArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 568     case rangeSize ixs     of { I# n# ->
 569     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 570     STret s2# (ByteArray ixs frozen#) }}
 571   where
 572     freeze  :: MutableByteArray# s      -- the thing
 573             -> Int#                     -- size of thing to be frozen
 574             -> State# s                 -- the Universe and everything
 575             -> StateAndByteArray# s
 576
 577     freeze arr# n# s#
 578       = case (newAddrArray# n# s#)         of { StateAndMutableByteArray# s2# newarr1# ->
 579         case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
 580         unsafeFreezeByteArray# newarr2# s3#
 581         }}
 582       where
 583         copy :: Int# -> Int#
 584              -> MutableByteArray# s -> MutableByteArray# s
 585              -> State# s
 586              -> StateAndMutableByteArray# s
 587
 588         copy cur# end# from# to# s#
 589           | cur# ==# end#
 590             = StateAndMutableByteArray# s# to#
 591           | otherwise
 592             = case (readAddrArray#  from# cur#     s#)  of { StateAndAddr# s1# ele ->
 593               case (writeAddrArray# to#   cur# ele s1#) of { s2# ->
 594               copy (cur# +# 1#) end# from# to# s2#
 595               }}
 596
 597 freezeFloatArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 598     case rangeSize ixs     of { I# n# ->
 599     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 600     STret s2# (ByteArray ixs frozen#) }}
 601   where
 602     freeze  :: MutableByteArray# s      -- the thing
 603             -> Int#                     -- size of thing to be frozen
 604             -> State# s                 -- the Universe and everything
 605             -> StateAndByteArray# s
 606
 607     freeze arr# end# s#
 608       = case (newFloatArray# end# s#)   of { StateAndMutableByteArray# s2# newarr1# ->
 609         case copy 0# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
 610         unsafeFreezeByteArray# newarr2# s3#
 611         }}
 612       where
 613         copy :: Int#
 614              -> MutableByteArray# s -> MutableByteArray# s
 615              -> State# s
 616              -> StateAndMutableByteArray# s
 617
 618         copy cur# from# to# s#
 619           | cur# ==# end#
 620             = StateAndMutableByteArray# s# to#
 621           | otherwise
 622             = case (readFloatArray#  from# cur#     s#)  of { StateAndFloat# s1# ele ->
 623               case (writeFloatArray# to#   cur# ele s1#) of { s2# ->
 624               copy (cur# +# 1#) from# to# s2#
 625               }}
 626
 627 freezeDoubleArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 628     case rangeSize ixs     of { I# n# ->
 629     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 630     STret s2# (ByteArray ixs frozen#) }}
 631   where
 632     freeze  :: MutableByteArray# s      -- the thing
 633             -> Int#                     -- size of thing to be frozen
 634             -> State# s                 -- the Universe and everything
 635             -> StateAndByteArray# s
 636
 637     freeze arr# n# s#
 638       = case (newDoubleArray# n# s#)       of { StateAndMutableByteArray# s2# newarr1# ->
 639         case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
 640         unsafeFreezeByteArray# newarr2# s3#
 641         }}
 642       where
 643         copy :: Int# -> Int#
 644              -> MutableByteArray# s -> MutableByteArray# s
 645              -> State# s
 646              -> StateAndMutableByteArray# s
 647
 648         copy cur# end# from# to# s#
 649           | cur# ==# end#
 650             = StateAndMutableByteArray# s# to#
 651           | otherwise
 652             = case (readDoubleArray#  from# cur#     s#)  of { StateAndDouble# s1# ele ->
 653               case (writeDoubleArray# to#   cur# ele s1#) of { s2# ->
 654               copy (cur# +# 1#) end# from# to# s2#
 655               }}
 656
 657 unsafeFreezeArray     :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
 658 unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 659
 660 {-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
 661   #-}
 662
 663 unsafeFreezeArray (MutableArray ixs arr#) = ST $ \ s# ->
 664     case unsafeFreezeArray# arr# s# of { StateAndArray# s2# frozen# ->
 665     STret s2# (Array ixs frozen#) }
 666
 667 unsafeFreezeByteArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 668     case unsafeFreezeByteArray# arr# s# of { StateAndByteArray# s2# frozen# ->
 669     STret s2# (ByteArray ixs frozen#) }
 670
 671
 672 --This takes a immutable array, and copies it into a mutable array, in a
 673 --hurry.
 674
 675 {-# SPECIALISE thawArray :: Array Int elt -> ST s (MutableArray s Int elt),
 676                             Array IPr elt -> ST s (MutableArray s IPr elt)
 677   #-}
 678
 679 thawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
 680 thawArray (Array ixs arr#) = ST $ \ s# ->
 681     case rangeSize ixs     of { I# n# ->
 682     case thaw arr# n# s# of { StateAndMutableArray# s2# thawed# ->
 683     STret s2# (MutableArray ixs thawed#)}}
 684   where
 685     thaw  :: Array# ele                 -- the thing
 686             -> Int#                     -- size of thing to be thawed
 687             -> State# s                 -- the Universe and everything
 688             -> StateAndMutableArray# s ele
 689
 690     thaw arr# n# s#
 691       = case newArray# n# init s#             of { StateAndMutableArray# s2# newarr1# ->
 692         copy 0# n# arr# newarr1# s2# }
 693       where
 694         init = error "thawArray: element not copied"
 695
 696         copy :: Int# -> Int#
 697              -> Array# ele
 698              -> MutableArray# s ele
 699              -> State# s
 700              -> StateAndMutableArray# s ele
 701
 702         copy cur# end# from# to# s#
 703           | cur# ==# end#
 704             = StateAndMutableArray# s# to#
 705           | otherwise
 706             = case indexArray#  from# cur#       of { Lift ele ->
 707               case writeArray# to#   cur# ele s# of { s1# ->
 708               copy (cur# +# 1#) end# from# to# s1#
 709               }}
 710 \end{code}
 711
 712 %*********************************************************
 713 %*                                                      *
 714 \subsection{Ghastly return types}
 715 %*                                                      *
 716 %*********************************************************
 717
 718 \begin{code}
 719 data StateAndArray#            s elt = StateAndArray#        (State# s) (Array# elt)
 720 data StateAndMutableArray#     s elt = StateAndMutableArray# (State# s) (MutableArray# s elt)
 721 data StateAndByteArray#        s = StateAndByteArray#        (State# s) ByteArray#
 722 data StateAndMutableByteArray# s = StateAndMutableByteArray# (State# s) (MutableByteArray# s)
 723 \end{code}