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 {-# GENERATE_SPECS array a{~,Int,IPr} b{} #-}
  28 array                 :: (Ix a) => (a,a) -> [(a,b)] -> Array a b
  29
  30 {-# GENERATE_SPECS (!) a{~,Int,IPr} b{} #-}
  31 (!)                   :: (Ix a) => Array a b -> a -> b
  32
  33 bounds                :: (Ix a) => Array a b -> (a,a)
  34
  35 {-# GENERATE_SPECS (//) a{~,Int,IPr} b{} #-}
  36 (//)                  :: (Ix a) => Array a b -> [(a,b)] -> Array a b
  37
  38 {-# GENERATE_SPECS accum a{~,Int,IPr} b{} c{} #-}
  39 accum                 :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b
  40
  41 {-# GENERATE_SPECS accumArray a{~,Int,IPr} b{} c{} #-}
  42 accumArray            :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b
  43 \end{code}
  44
  45
  46 %*********************************************************
  47 %*                                                      *
  48 \subsection{The @Array@ types}
  49 %*                                                      *
  50 %*********************************************************
  51
  52 \begin{code}
  53 type IPr = (Int, Int)
  54
  55 data Ix ix => Array ix elt              = Array            (ix,ix) (Array# elt)
  56 data Ix ix => ByteArray ix              = ByteArray        (ix,ix) ByteArray#
  57 data Ix ix => MutableArray     s ix elt = MutableArray     (ix,ix) (MutableArray# s elt)
  58 data Ix ix => MutableByteArray s ix     = MutableByteArray (ix,ix) (MutableByteArray# s)
  59
  60 instance CCallable (MutableByteArray s ix)
  61 instance CCallable (MutableByteArray# s)
  62
  63 instance CCallable (ByteArray ix)
  64 instance CCallable ByteArray#
  65
  66 -- A one-element mutable array:
  67 type MutableVar s a = MutableArray s Int a
  68
  69 -- just pointer equality on arrays:
  70 instance Eq (MutableArray s ix elt) where
  71         MutableArray _ arr1# == MutableArray _ arr2#
  72                 = sameMutableArray# arr1# arr2#
  73
  74 instance Eq (MutableByteArray s ix) where
  75         MutableByteArray _ arr1# == MutableByteArray _ arr2#
  76                 = sameMutableByteArray# arr1# arr2#
  77 \end{code}
  78
  79 %*********************************************************
  80 %*                                                      *
  81 \subsection{Operations on mutable variables}
  82 %*                                                      *
  83 %*********************************************************
  84
  85 \begin{code}
  86 newVar   :: a -> ST s (MutableVar s a)
  87 readVar  :: MutableVar s a -> ST s a
  88 writeVar :: MutableVar s a -> a -> ST s ()
  89
  90 newVar init = ST $ \ s# ->
  91     case (newArray# 1# init s#)     of { StateAndMutableArray# s2# arr# ->
  92     STret s2# (MutableArray vAR_IXS arr#) }
  93   where
  94     vAR_IXS = error "newVar: Shouldn't access `bounds' of a MutableVar\n"
  95
  96 readVar (MutableArray _ var#) = ST $ \ s# ->
  97     case readArray# var# 0# s#  of { StateAndPtr# s2# r ->
  98     STret s2# r }
  99
 100 writeVar (MutableArray _ var#) val = ST $ \ s# ->
 101     case writeArray# var# 0# val s# of { s2# ->
 102     STret 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       Lift 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 { STret 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 newAddrArray   :: IPr -> ST s (MutableByteArray s Int) #-}
 225 {-# SPECIALIZE newFloatArray  :: IPr -> ST s (MutableByteArray s Int) #-}
 226 {-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-}
 227
 228 newArray ixs init = ST $ \ s# ->
 229     case rangeSize ixs              of { I# n# ->
 230     case (newArray# n# init s#)     of { StateAndMutableArray# s2# arr# ->
 231     STret s2# (MutableArray ixs arr#) }}
 232
 233 newCharArray ixs = ST $ \ s# ->
 234     case rangeSize ixs              of { I# n# ->
 235     case (newCharArray# n# s#)    of { StateAndMutableByteArray# s2# barr# ->
 236     STret s2# (MutableByteArray ixs barr#) }}
 237
 238 newIntArray ixs = ST $ \ s# ->
 239     case rangeSize ixs              of { I# n# ->
 240     case (newIntArray# n# s#)     of { StateAndMutableByteArray# s2# barr# ->
 241     STret s2# (MutableByteArray ixs barr#) }}
 242
 243 newAddrArray ixs = ST $ \ s# ->
 244     case rangeSize ixs              of { I# n# ->
 245     case (newAddrArray# n# s#)    of { StateAndMutableByteArray# s2# barr# ->
 246     STret s2# (MutableByteArray ixs barr#) }}
 247
 248 newFloatArray ixs = ST $ \ s# ->
 249     case rangeSize ixs              of { I# n# ->
 250     case (newFloatArray# n# s#)   of { StateAndMutableByteArray# s2# barr# ->
 251     STret s2# (MutableByteArray ixs barr#) }}
 252
 253 newDoubleArray ixs = ST $ \ s# ->
 254     case rangeSize ixs              of { I# n# ->
 255     case (newDoubleArray# n# s#)  of { StateAndMutableByteArray# s2# barr# ->
 256     STret s2# (MutableByteArray ixs barr#) }}
 257
 258 boundsOfArray     :: Ix ix => MutableArray s ix elt -> (ix, ix)
 259 boundsOfByteArray :: Ix ix => MutableByteArray s ix -> (ix, ix)
 260
 261 {-# SPECIALIZE boundsOfArray     :: MutableArray s Int elt -> IPr #-}
 262 {-# SPECIALIZE boundsOfByteArray :: MutableByteArray s Int -> IPr #-}
 263
 264 boundsOfArray     (MutableArray     ixs _) = ixs
 265 boundsOfByteArray (MutableByteArray ixs _) = ixs
 266
 267 readArray       :: Ix ix => MutableArray s ix elt -> ix -> ST s elt
 268
 269 readCharArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Char
 270 readIntArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
 271 readAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr
 272 readFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
 273 readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
 274
 275 {-# SPECIALIZE readArray       :: MutableArray s Int elt -> Int -> ST s elt,
 276                                   MutableArray s IPr elt -> IPr -> ST s elt
 277   #-}
 278 {-# SPECIALIZE readCharArray   :: MutableByteArray s Int -> Int -> ST s Char #-}
 279 {-# SPECIALIZE readIntArray    :: MutableByteArray s Int -> Int -> ST s Int #-}
 280 {-# SPECIALIZE readAddrArray   :: MutableByteArray s Int -> Int -> ST s Addr #-}
 281 --NO:{-# SPECIALIZE readFloatArray  :: MutableByteArray s Int -> Int -> ST s Float #-}
 282 {-# SPECIALIZE readDoubleArray :: MutableByteArray s Int -> Int -> ST s Double #-}
 283
 284 readArray (MutableArray ixs arr#) n = ST $ \ s# ->
 285     case (index ixs n)          of { I# n# ->
 286     case readArray# arr# n# s#  of { StateAndPtr# s2# r ->
 287     STret s2# r }}
 288
 289 readCharArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 290     case (index ixs n)                  of { I# n# ->
 291     case readCharArray# barr# n# s#     of { StateAndChar# s2# r# ->
 292     STret s2# (C# r#) }}
 293
 294 readIntArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 295     case (index ixs n)                  of { I# n# ->
 296     case readIntArray# barr# n# s#      of { StateAndInt# s2# r# ->
 297     STret s2# (I# r#) }}
 298
 299 readAddrArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 300     case (index ixs n)                  of { I# n# ->
 301     case readAddrArray# barr# n# s#     of { StateAndAddr# s2# r# ->
 302     STret s2# (A# r#) }}
 303
 304 readFloatArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 305     case (index ixs n)                  of { I# n# ->
 306     case readFloatArray# barr# n# s#    of { StateAndFloat# s2# r# ->
 307     STret s2# (F# r#) }}
 308
 309 readDoubleArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 310     case (index ixs n)                  of { I# n# ->
 311     case readDoubleArray# barr# n# s#   of { StateAndDouble# s2# r# ->
 312     STret s2# (D# r#) }}
 313
 314 --Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
 315 indexCharArray   :: Ix ix => ByteArray ix -> ix -> Char
 316 indexIntArray    :: Ix ix => ByteArray ix -> ix -> Int
 317 indexAddrArray   :: Ix ix => ByteArray ix -> ix -> Addr
 318 indexFloatArray  :: Ix ix => ByteArray ix -> ix -> Float
 319 indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double
 320
 321 {-# SPECIALIZE indexCharArray   :: ByteArray Int -> Int -> Char #-}
 322 {-# SPECIALIZE indexIntArray    :: ByteArray Int -> Int -> Int #-}
 323 {-# SPECIALIZE indexAddrArray   :: ByteArray Int -> Int -> Addr #-}
 324 --NO:{-# SPECIALIZE indexFloatArray  :: ByteArray Int -> Int -> Float #-}
 325 {-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-}
 326
 327 indexCharArray (ByteArray ixs barr#) n
 328   = case (index ixs n)                  of { I# n# ->
 329     case indexCharArray# barr# n#       of { r# ->
 330     (C# r#)}}
 331
 332 indexIntArray (ByteArray ixs barr#) n
 333   = case (index ixs n)                  of { I# n# ->
 334     case indexIntArray# barr# n#        of { r# ->
 335     (I# r#)}}
 336
 337 indexAddrArray (ByteArray ixs barr#) n
 338   = case (index ixs n)                  of { I# n# ->
 339     case indexAddrArray# barr# n#       of { r# ->
 340     (A# r#)}}
 341
 342 indexFloatArray (ByteArray ixs barr#) n
 343   = case (index ixs n)                  of { I# n# ->
 344     case indexFloatArray# barr# n#      of { r# ->
 345     (F# r#)}}
 346
 347 indexDoubleArray (ByteArray ixs barr#) n
 348   = case (index ixs n)                  of { I# n# ->
 349     case indexDoubleArray# barr# n#     of { r# ->
 350     (D# r#)}}
 351
 352 --Indexing off @Addrs@ is similar, and therefore given here.
 353 indexCharOffAddr   :: Addr -> Int -> Char
 354 indexIntOffAddr    :: Addr -> Int -> Int
 355 indexAddrOffAddr   :: Addr -> Int -> Addr
 356 indexFloatOffAddr  :: Addr -> Int -> Float
 357 indexDoubleOffAddr :: Addr -> Int -> Double
 358
 359 indexCharOffAddr (A# addr#) n
 360   = case n                              of { I# n# ->
 361     case indexCharOffAddr# addr# n#     of { r# ->
 362     (C# r#)}}
 363
 364 indexIntOffAddr (A# addr#) n
 365   = case n                              of { I# n# ->
 366     case indexIntOffAddr# addr# n#      of { r# ->
 367     (I# r#)}}
 368
 369 indexAddrOffAddr (A# addr#) n
 370   = case n                              of { I# n# ->
 371     case indexAddrOffAddr# addr# n#     of { r# ->
 372     (A# r#)}}
 373
 374 indexFloatOffAddr (A# addr#) n
 375   = case n                              of { I# n# ->
 376     case indexFloatOffAddr# addr# n#    of { r# ->
 377     (F# r#)}}
 378
 379 indexDoubleOffAddr (A# addr#) n
 380   = case n                              of { I# n# ->
 381     case indexDoubleOffAddr# addr# n#   of { r# ->
 382     (D# r#)}}
 383
 384 writeArray       :: Ix ix => MutableArray s ix elt -> ix -> elt -> ST s ()
 385 writeCharArray   :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s ()
 386 writeIntArray    :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s ()
 387 writeAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s ()
 388 writeFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s ()
 389 writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s ()
 390
 391 {-# SPECIALIZE writeArray       :: MutableArray s Int elt -> Int -> elt -> ST s (),
 392                                    MutableArray s IPr elt -> IPr -> elt -> ST s ()
 393   #-}
 394 {-# SPECIALIZE writeCharArray   :: MutableByteArray s Int -> Int -> Char -> ST s () #-}
 395 {-# SPECIALIZE writeIntArray    :: MutableByteArray s Int -> Int -> Int  -> ST s () #-}
 396 {-# SPECIALIZE writeAddrArray   :: MutableByteArray s Int -> Int -> Addr -> ST s () #-}
 397 --NO:{-# SPECIALIZE writeFloatArray  :: MutableByteArray s Int -> Int -> Float -> ST s () #-}
 398 {-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-}
 399
 400 writeArray (MutableArray ixs arr#) n ele = ST $ \ s# ->
 401     case index ixs n                of { I# n# ->
 402     case writeArray# arr# n# ele s# of { s2# ->
 403     STret s2# () }}
 404
 405 writeCharArray (MutableByteArray ixs barr#) n (C# ele) = ST $ \ s# ->
 406     case (index ixs n)                      of { I# n# ->
 407     case writeCharArray# barr# n# ele s#    of { s2#   ->
 408     STret s2# () }}
 409
 410 writeIntArray (MutableByteArray ixs barr#) n (I# ele) = ST $ \ s# ->
 411     case (index ixs n)                      of { I# n# ->
 412     case writeIntArray# barr# n# ele s#     of { s2#   ->
 413     STret s2# () }}
 414
 415 writeAddrArray (MutableByteArray ixs barr#) n (A# ele) = ST $ \ s# ->
 416     case (index ixs n)                      of { I# n# ->
 417     case writeAddrArray# barr# n# ele s#    of { s2#   ->
 418     STret s2# () }}
 419
 420 writeFloatArray (MutableByteArray ixs barr#) n (F# ele) = ST $ \ s# ->
 421     case (index ixs n)                      of { I# n# ->
 422     case writeFloatArray# barr# n# ele s#   of { s2#   ->
 423     STret s2# () }}
 424
 425 writeDoubleArray (MutableByteArray ixs barr#) n (D# ele) = ST $ \ s# ->
 426     case (index ixs n)                      of { I# n# ->
 427     case writeDoubleArray# barr# n# ele s#  of { s2#   ->
 428     STret s2# () }}
 429 \end{code}
 430
 431
 432 %*********************************************************
 433 %*                                                      *
 434 \subsection{Moving between mutable and immutable}
 435 %*                                                      *
 436 %*********************************************************
 437
 438 \begin{code}
 439 freezeArray       :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
 440 freezeCharArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 441 freezeIntArray    :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 442 freezeAddrArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 443 freezeFloatArray  :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 444 freezeDoubleArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 445
 446 {-# SPECIALISE freezeArray :: MutableArray s Int elt -> ST s (Array Int elt),
 447                               MutableArray s IPr elt -> ST s (Array IPr elt)
 448   #-}
 449 {-# SPECIALISE freezeCharArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
 450
 451 freezeArray (MutableArray ixs arr#) = ST $ \ s# ->
 452     case rangeSize ixs     of { I# n# ->
 453     case freeze arr# n# s# of { StateAndArray# s2# frozen# ->
 454     STret s2# (Array ixs frozen#) }}
 455   where
 456     freeze  :: MutableArray# s ele      -- the thing
 457             -> Int#                     -- size of thing to be frozen
 458             -> State# s                 -- the Universe and everything
 459             -> StateAndArray# s ele
 460
 461     freeze arr# n# s#
 462       = case newArray# n# init s#             of { StateAndMutableArray# s2# newarr1# ->
 463         case copy 0# n# arr# newarr1# s2#     of { StateAndMutableArray# s3# newarr2# ->
 464         unsafeFreezeArray# newarr2# s3#
 465         }}
 466       where
 467         init = error "freezeArray: element not copied"
 468
 469         copy :: Int# -> Int#
 470              -> MutableArray# s ele -> MutableArray# s ele
 471              -> State# s
 472              -> StateAndMutableArray# s ele
 473
 474         copy cur# end# from# to# s#
 475           | cur# ==# end#
 476             = StateAndMutableArray# s# to#
 477           | otherwise
 478             = case readArray#  from# cur#     s#  of { StateAndPtr# s1# ele ->
 479               case writeArray# to#   cur# ele s1# of { s2# ->
 480               copy (cur# +# 1#) end# from# to# s2#
 481               }}
 482
 483 freezeCharArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 484     case rangeSize ixs     of { I# n# ->
 485     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 486     STret s2# (ByteArray ixs frozen#) }}
 487   where
 488     freeze  :: MutableByteArray# s      -- the thing
 489             -> Int#                     -- size of thing to be frozen
 490             -> State# s                 -- the Universe and everything
 491             -> StateAndByteArray# s
 492
 493     freeze arr# n# s#
 494       = case (newCharArray# n# s#)         of { StateAndMutableByteArray# s2# newarr1# ->
 495         case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
 496         unsafeFreezeByteArray# newarr2# s3#
 497         }}
 498       where
 499         copy :: Int# -> Int#
 500              -> MutableByteArray# s -> MutableByteArray# s
 501              -> State# s
 502              -> StateAndMutableByteArray# s
 503
 504         copy cur# end# from# to# s#
 505           | cur# ==# end#
 506             = StateAndMutableByteArray# s# to#
 507           | otherwise
 508             = case (readCharArray#  from# cur#     s#)  of { StateAndChar# s1# ele ->
 509               case (writeCharArray# to#   cur# ele s1#) of { s2# ->
 510               copy (cur# +# 1#) end# from# to# s2#
 511               }}
 512
 513 freezeIntArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 514     case rangeSize ixs     of { I# n# ->
 515     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 516     STret s2# (ByteArray ixs frozen#) }}
 517   where
 518     freeze  :: MutableByteArray# s      -- the thing
 519             -> Int#                     -- size of thing to be frozen
 520             -> State# s                 -- the Universe and everything
 521             -> StateAndByteArray# s
 522
 523     freeze arr# n# s#
 524       = case (newIntArray# n# s#)          of { StateAndMutableByteArray# s2# newarr1# ->
 525         case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
 526         unsafeFreezeByteArray# newarr2# s3#
 527         }}
 528       where
 529         copy :: Int# -> Int#
 530              -> MutableByteArray# s -> MutableByteArray# s
 531              -> State# s
 532              -> StateAndMutableByteArray# s
 533
 534         copy cur# end# from# to# s#
 535           | cur# ==# end#
 536             = StateAndMutableByteArray# s# to#
 537           | otherwise
 538             = case (readIntArray#  from# cur#     s#)  of { StateAndInt# s1# ele ->
 539               case (writeIntArray# to#   cur# ele s1#) of { s2# ->
 540               copy (cur# +# 1#) end# from# to# s2#
 541               }}
 542
 543 freezeAddrArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 544     case rangeSize ixs     of { I# n# ->
 545     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 546     STret s2# (ByteArray ixs frozen#) }}
 547   where
 548     freeze  :: MutableByteArray# s      -- the thing
 549             -> Int#                     -- size of thing to be frozen
 550             -> State# s                 -- the Universe and everything
 551             -> StateAndByteArray# s
 552
 553     freeze arr# n# s#
 554       = case (newAddrArray# n# s#)         of { StateAndMutableByteArray# s2# newarr1# ->
 555         case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
 556         unsafeFreezeByteArray# newarr2# s3#
 557         }}
 558       where
 559         copy :: Int# -> Int#
 560              -> MutableByteArray# s -> MutableByteArray# s
 561              -> State# s
 562              -> StateAndMutableByteArray# s
 563
 564         copy cur# end# from# to# s#
 565           | cur# ==# end#
 566             = StateAndMutableByteArray# s# to#
 567           | otherwise
 568             = case (readAddrArray#  from# cur#     s#)  of { StateAndAddr# s1# ele ->
 569               case (writeAddrArray# to#   cur# ele s1#) of { s2# ->
 570               copy (cur# +# 1#) end# from# to# s2#
 571               }}
 572
 573 freezeFloatArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 574     case rangeSize ixs     of { I# n# ->
 575     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 576     STret s2# (ByteArray ixs frozen#) }}
 577   where
 578     freeze  :: MutableByteArray# s      -- the thing
 579             -> Int#                     -- size of thing to be frozen
 580             -> State# s                 -- the Universe and everything
 581             -> StateAndByteArray# s
 582
 583     freeze arr# end# s#
 584       = case (newFloatArray# end# s#)   of { StateAndMutableByteArray# s2# newarr1# ->
 585         case copy 0# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
 586         unsafeFreezeByteArray# newarr2# s3#
 587         }}
 588       where
 589         copy :: Int#
 590              -> MutableByteArray# s -> MutableByteArray# s
 591              -> State# s
 592              -> StateAndMutableByteArray# s
 593
 594         copy cur# from# to# s#
 595           | cur# ==# end#
 596             = StateAndMutableByteArray# s# to#
 597           | otherwise
 598             = case (readFloatArray#  from# cur#     s#)  of { StateAndFloat# s1# ele ->
 599               case (writeFloatArray# to#   cur# ele s1#) of { s2# ->
 600               copy (cur# +# 1#) from# to# s2#
 601               }}
 602
 603 freezeDoubleArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 604     case rangeSize ixs     of { I# n# ->
 605     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 606     STret s2# (ByteArray ixs frozen#) }}
 607   where
 608     freeze  :: MutableByteArray# s      -- the thing
 609             -> Int#                     -- size of thing to be frozen
 610             -> State# s                 -- the Universe and everything
 611             -> StateAndByteArray# s
 612
 613     freeze arr# n# s#
 614       = case (newDoubleArray# n# s#)       of { StateAndMutableByteArray# s2# newarr1# ->
 615         case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
 616         unsafeFreezeByteArray# newarr2# s3#
 617         }}
 618       where
 619         copy :: Int# -> Int#
 620              -> MutableByteArray# s -> MutableByteArray# s
 621              -> State# s
 622              -> StateAndMutableByteArray# s
 623
 624         copy cur# end# from# to# s#
 625           | cur# ==# end#
 626             = StateAndMutableByteArray# s# to#
 627           | otherwise
 628             = case (readDoubleArray#  from# cur#     s#)  of { StateAndDouble# s1# ele ->
 629               case (writeDoubleArray# to#   cur# ele s1#) of { s2# ->
 630               copy (cur# +# 1#) end# from# to# s2#
 631               }}
 632
 633 unsafeFreezeArray     :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
 634 unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 635
 636 {-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
 637   #-}
 638
 639 unsafeFreezeArray (MutableArray ixs arr#) = ST $ \ s# ->
 640     case unsafeFreezeArray# arr# s# of { StateAndArray# s2# frozen# ->
 641     STret s2# (Array ixs frozen#) }
 642
 643 unsafeFreezeByteArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 644     case unsafeFreezeByteArray# arr# s# of { StateAndByteArray# s2# frozen# ->
 645     STret s2# (ByteArray ixs frozen#) }
 646
 647
 648 --This takes a immutable array, and copies it into a mutable array, in a
 649 --hurry.
 650
 651 {-# SPECIALISE thawArray :: Array Int elt -> ST s (MutableArray s Int elt),
 652                             Array IPr elt -> ST s (MutableArray s IPr elt)
 653   #-}
 654
 655 thawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
 656 thawArray (Array ixs arr#) = ST $ \ s# ->
 657     case rangeSize ixs     of { I# n# ->
 658     case thaw arr# n# s# of { StateAndMutableArray# s2# thawed# ->
 659     STret s2# (MutableArray ixs thawed#)}}
 660   where
 661     thaw  :: Array# ele                 -- the thing
 662             -> Int#                     -- size of thing to be thawed
 663             -> State# s                 -- the Universe and everything
 664             -> StateAndMutableArray# s ele
 665
 666     thaw arr# n# s#
 667       = case newArray# n# init s#             of { StateAndMutableArray# s2# newarr1# ->
 668         copy 0# n# arr# newarr1# s2# }
 669       where
 670         init = error "thawArray: element not copied"
 671
 672         copy :: Int# -> Int#
 673              -> Array# ele
 674              -> MutableArray# s ele
 675              -> State# s
 676              -> StateAndMutableArray# s ele
 677
 678         copy cur# end# from# to# s#
 679           | cur# ==# end#
 680             = StateAndMutableArray# s# to#
 681           | otherwise
 682             = case indexArray#  from# cur#       of { Lift ele ->
 683               case writeArray# to#   cur# ele s# of { s1# ->
 684               copy (cur# +# 1#) end# from# to# s1#
 685               }}
 686 \end{code}
 687
 688 %*********************************************************
 689 %*                                                      *
 690 \subsection{Ghastly return types}
 691 %*                                                      *
 692 %*********************************************************
 693
 694 \begin{code}
 695 data StateAndArray#            s elt = StateAndArray#        (State# s) (Array# elt)
 696 data StateAndMutableArray#     s elt = StateAndMutableArray# (State# s) (MutableArray# s elt)
 697 data StateAndByteArray#        s = StateAndByteArray#        (State# s) ByteArray#
 698 data StateAndMutableByteArray# s = StateAndMutableByteArray# (State# s) (MutableByteArray# s)
 699 \end{code}