ghc/lib/ghc/ArrBase.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4 \section[ArrBase]{Module @ArrBase@}
   5
   6 Array implementation, @ArrBase@ exports the basic array
   7 types and operations.
   8
   9 \begin{code}
  10 {-# OPTIONS -fno-implicit-prelude #-}
  11
  12 module ArrBase where
  13
  14 import {-# SOURCE #-}   IOBase  ( error )
  15 import Ix
  16 import PrelList (foldl)
  17 import STBase
  18 import PrelBase
  19 import Foreign
  20 import GHC
  21
  22 infixl 9  !, //
  23 \end{code}
  24
  25 \begin{code}
  26 {-# GENERATE_SPECS array a{~,Int,IPr} b{} #-}
  27 array                 :: (Ix a) => (a,a) -> [(a,b)] -> Array a b
  28
  29 {-# GENERATE_SPECS (!) a{~,Int,IPr} b{} #-}
  30 (!)                   :: (Ix a) => Array a b -> a -> b
  31
  32 bounds                :: (Ix a) => Array a b -> (a,a)
  33
  34 {-# GENERATE_SPECS (//) a{~,Int,IPr} b{} #-}
  35 (//)                  :: (Ix a) => Array a b -> [(a,b)] -> Array a b
  36
  37 {-# GENERATE_SPECS accum a{~,Int,IPr} b{} c{} #-}
  38 accum                 :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b
  39
  40 {-# GENERATE_SPECS accumArray a{~,Int,IPr} b{} c{} #-}
  41 accumArray            :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b
  42 \end{code}
  43
  44
  45 %*********************************************************
  46 %*                                                      *
  47 \subsection{The @Array@ types}
  48 %*                                                      *
  49 %*********************************************************
  50
  51 \begin{code}
  52 type IPr = (Int, Int)
  53
  54 data Ix ix => Array ix elt              = Array            (ix,ix) (Array# elt)
  55 data Ix ix => ByteArray ix              = ByteArray        (ix,ix) ByteArray#
  56 data Ix ix => MutableArray     s ix elt = MutableArray     (ix,ix) (MutableArray# s elt)
  57 data Ix ix => MutableByteArray s ix     = MutableByteArray (ix,ix) (MutableByteArray# s)
  58
  59 instance CCallable (MutableByteArray s ix)
  60 instance CCallable (MutableByteArray# s)
  61
  62 instance CCallable (ByteArray ix)
  63 instance CCallable ByteArray#
  64
  65 -- A one-element mutable array:
  66 type MutableVar s a = MutableArray s Int a
  67 \end{code}
  68
  69
  70 %*********************************************************
  71 %*                                                      *
  72 \subsection{Operations on immutable arrays}
  73 %*                                                      *
  74 %*********************************************************
  75
  76 "array", "!" and "bounds" are basic; the rest can be defined in terms of them
  77
  78 \begin{code}
  79 bounds (Array b _)  = b
  80
  81 (Array bounds arr#) ! i
  82   = let n# = case (index bounds i) of { I# x -> x } -- index fails if out of range
  83     in
  84     case (indexArray# arr# n#) of
  85       Lift v -> v
  86
  87 #ifdef USE_FOLDR_BUILD
  88 {-# INLINE array #-}
  89 #endif
  90 array ixs@(ix_start, ix_end) ivs =
  91    runST ( ST $ \ s ->
  92         case (newArray ixs arrEleBottom)        of { ST new_array_thing ->
  93         case (new_array_thing s)                of { STret s# arr@(MutableArray _ arr#) ->
  94         let
  95          fill_in s# [] = s#
  96          fill_in s# ((i,v):ivs) =
  97                 case (index ixs i)            of { I# n# ->
  98                 case writeArray# arr# n# v s# of { s2# ->
  99                 fill_in s2# ivs }}
 100         in
 101
 102         case (fill_in s# ivs)                   of { s# ->
 103         case (freezeArray arr)                  of { ST freeze_array_thing ->
 104         freeze_array_thing s# }}}})
 105
 106 arrEleBottom = error "(Array.!): undefined array element"
 107
 108 fill_it_in :: Ix ix => MutableArray s ix elt -> [(ix, elt)] -> ST s ()
 109 fill_it_in arr lst
 110   = foldr fill_one_in (returnST ()) lst
 111   where  -- **** STRICT **** (but that's OK...)
 112     fill_one_in (i, v) rst
 113       = writeArray arr i v `seqST` rst
 114
 115 -----------------------------------------------------------------------
 116 -- these also go better with magic: (//), accum, accumArray
 117
 118 old_array // ivs
 119   = runST (
 120         -- copy the old array:
 121         thawArray old_array                 `thenST` \ arr ->
 122         -- now write the new elements into the new array:
 123         fill_it_in arr ivs                  `seqST`
 124         freezeArray arr
 125     )
 126   where
 127     bottom = error "(Array.//): error in copying old array\n"
 128
 129 zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> MutableArray s ix elt -> [(ix,elt2)] -> ST s ()
 130 -- zap_with_f: reads an elem out first, then uses "f" on that and the new value
 131
 132 zap_with_f f arr lst
 133   = foldr zap_one (returnST ()) lst
 134   where
 135     zap_one (i, new_v) rst
 136       = readArray  arr i                 `thenST`  \ old_v ->
 137         writeArray arr i (f old_v new_v) `seqST`
 138         rst
 139
 140 accum f old_array ivs
 141   = runST (
 142         -- copy the old array:
 143         thawArray old_array                 `thenST` \ arr ->
 144
 145         -- now zap the elements in question with "f":
 146         zap_with_f f arr ivs            >>
 147         freezeArray arr
 148     )
 149   where
 150     bottom = error "Array.accum: error in copying old array\n"
 151
 152 accumArray f zero ixs ivs
 153   = runST (
 154         newArray ixs zero       >>= \ arr# ->
 155         zap_with_f f  arr# ivs  >>
 156         freezeArray arr#
 157     )
 158 \end{code}
 159
 160
 161 %*********************************************************
 162 %*                                                      *
 163 \subsection{Operations on mutable arrays}
 164 %*                                                      *
 165 %*********************************************************
 166
 167 Idle ADR question: What's the tradeoff here between flattening these
 168 datatypes into @MutableArray ix ix (MutableArray# s elt)@ and using
 169 it as is?  As I see it, the former uses slightly less heap and
 170 provides faster access to the individual parts of the bounds while the
 171 code used has the benefit of providing a ready-made @(lo, hi)@ pair as
 172 required by many array-related functions.  Which wins? Is the
 173 difference significant (probably not).
 174
 175 Idle AJG answer: When I looked at the outputted code (though it was 2
 176 years ago) it seems like you often needed the tuple, and we build
 177 it frequently. Now we've got the overloading specialiser things
 178 might be different, though.
 179
 180 \begin{code}
 181 newArray :: Ix ix => (ix,ix) -> elt -> ST s (MutableArray s ix elt)
 182 newCharArray, newIntArray, newAddrArray, newFloatArray, newDoubleArray
 183          :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
 184
 185 {-# SPECIALIZE newArray      :: IPr       -> elt -> ST s (MutableArray s Int elt),
 186                                 (IPr,IPr) -> elt -> ST s (MutableArray s IPr elt)
 187   #-}
 188 {-# SPECIALIZE newCharArray   :: IPr -> ST s (MutableByteArray s Int) #-}
 189 {-# SPECIALIZE newIntArray    :: IPr -> ST s (MutableByteArray s Int) #-}
 190 {-# SPECIALIZE newAddrArray   :: IPr -> ST s (MutableByteArray s Int) #-}
 191 {-# SPECIALIZE newFloatArray  :: IPr -> ST s (MutableByteArray s Int) #-}
 192 {-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-}
 193
 194 newArray ixs init = ST $ \ s# ->
 195     case rangeSize ixs              of { I# n# ->
 196     case (newArray# n# init s#)     of { StateAndMutableArray# s2# arr# ->
 197     STret s2# (MutableArray ixs arr#) }}
 198
 199 newCharArray ixs = ST $ \ s# ->
 200     case rangeSize ixs              of { I# n# ->
 201     case (newCharArray# n# s#)    of { StateAndMutableByteArray# s2# barr# ->
 202     STret s2# (MutableByteArray ixs barr#) }}
 203
 204 newIntArray ixs = ST $ \ s# ->
 205     case rangeSize ixs              of { I# n# ->
 206     case (newIntArray# n# s#)     of { StateAndMutableByteArray# s2# barr# ->
 207     STret s2# (MutableByteArray ixs barr#) }}
 208
 209 newAddrArray ixs = ST $ \ s# ->
 210     case rangeSize ixs              of { I# n# ->
 211     case (newAddrArray# n# s#)    of { StateAndMutableByteArray# s2# barr# ->
 212     STret s2# (MutableByteArray ixs barr#) }}
 213
 214 newFloatArray ixs = ST $ \ s# ->
 215     case rangeSize ixs              of { I# n# ->
 216     case (newFloatArray# n# s#)   of { StateAndMutableByteArray# s2# barr# ->
 217     STret s2# (MutableByteArray ixs barr#) }}
 218
 219 newDoubleArray ixs = ST $ \ s# ->
 220     case rangeSize ixs              of { I# n# ->
 221     case (newDoubleArray# n# s#)  of { StateAndMutableByteArray# s2# barr# ->
 222     STret s2# (MutableByteArray ixs barr#) }}
 223
 224 boundsOfArray     :: Ix ix => MutableArray s ix elt -> (ix, ix)
 225 boundsOfByteArray :: Ix ix => MutableByteArray s ix -> (ix, ix)
 226
 227 {-# SPECIALIZE boundsOfArray     :: MutableArray s Int elt -> IPr #-}
 228 {-# SPECIALIZE boundsOfByteArray :: MutableByteArray s Int -> IPr #-}
 229
 230 boundsOfArray     (MutableArray     ixs _) = ixs
 231 boundsOfByteArray (MutableByteArray ixs _) = ixs
 232
 233 readArray       :: Ix ix => MutableArray s ix elt -> ix -> ST s elt
 234
 235 readCharArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Char
 236 readIntArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
 237 readAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr
 238 readFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
 239 readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
 240
 241 {-# SPECIALIZE readArray       :: MutableArray s Int elt -> Int -> ST s elt,
 242                                   MutableArray s IPr elt -> IPr -> ST s elt
 243   #-}
 244 {-# SPECIALIZE readCharArray   :: MutableByteArray s Int -> Int -> ST s Char #-}
 245 {-# SPECIALIZE readIntArray    :: MutableByteArray s Int -> Int -> ST s Int #-}
 246 {-# SPECIALIZE readAddrArray   :: MutableByteArray s Int -> Int -> ST s Addr #-}
 247 --NO:{-# SPECIALIZE readFloatArray  :: MutableByteArray s Int -> Int -> ST s Float #-}
 248 {-# SPECIALIZE readDoubleArray :: MutableByteArray s Int -> Int -> ST s Double #-}
 249
 250 readArray (MutableArray ixs arr#) n = ST $ \ s# ->
 251     case (index ixs n)          of { I# n# ->
 252     case readArray# arr# n# s#  of { StateAndPtr# s2# r ->
 253     STret s2# r }}
 254
 255 readCharArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 256     case (index ixs n)                  of { I# n# ->
 257     case readCharArray# barr# n# s#     of { StateAndChar# s2# r# ->
 258     STret s2# (C# r#) }}
 259
 260 readIntArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 261     case (index ixs n)                  of { I# n# ->
 262     case readIntArray# barr# n# s#      of { StateAndInt# s2# r# ->
 263     STret s2# (I# r#) }}
 264
 265 readAddrArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 266     case (index ixs n)                  of { I# n# ->
 267     case readAddrArray# barr# n# s#     of { StateAndAddr# s2# r# ->
 268     STret s2# (A# r#) }}
 269
 270 readFloatArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 271     case (index ixs n)                  of { I# n# ->
 272     case readFloatArray# barr# n# s#    of { StateAndFloat# s2# r# ->
 273     STret s2# (F# r#) }}
 274
 275 readDoubleArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
 276     case (index ixs n)                  of { I# n# ->
 277     case readDoubleArray# barr# n# s#   of { StateAndDouble# s2# r# ->
 278     STret s2# (D# r#) }}
 279
 280 --Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
 281 indexCharArray   :: Ix ix => ByteArray ix -> ix -> Char
 282 indexIntArray    :: Ix ix => ByteArray ix -> ix -> Int
 283 indexAddrArray   :: Ix ix => ByteArray ix -> ix -> Addr
 284 indexFloatArray  :: Ix ix => ByteArray ix -> ix -> Float
 285 indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double
 286
 287 {-# SPECIALIZE indexCharArray   :: ByteArray Int -> Int -> Char #-}
 288 {-# SPECIALIZE indexIntArray    :: ByteArray Int -> Int -> Int #-}
 289 {-# SPECIALIZE indexAddrArray   :: ByteArray Int -> Int -> Addr #-}
 290 --NO:{-# SPECIALIZE indexFloatArray  :: ByteArray Int -> Int -> Float #-}
 291 {-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-}
 292
 293 indexCharArray (ByteArray ixs barr#) n
 294   = case (index ixs n)                  of { I# n# ->
 295     case indexCharArray# barr# n#       of { r# ->
 296     (C# r#)}}
 297
 298 indexIntArray (ByteArray ixs barr#) n
 299   = case (index ixs n)                  of { I# n# ->
 300     case indexIntArray# barr# n#        of { r# ->
 301     (I# r#)}}
 302
 303 indexAddrArray (ByteArray ixs barr#) n
 304   = case (index ixs n)                  of { I# n# ->
 305     case indexAddrArray# barr# n#       of { r# ->
 306     (A# r#)}}
 307
 308 indexFloatArray (ByteArray ixs barr#) n
 309   = case (index ixs n)                  of { I# n# ->
 310     case indexFloatArray# barr# n#      of { r# ->
 311     (F# r#)}}
 312
 313 indexDoubleArray (ByteArray ixs barr#) n
 314   = case (index ixs n)                  of { I# n# ->
 315     case indexDoubleArray# barr# n#     of { r# ->
 316     (D# r#)}}
 317
 318 --Indexing off @Addrs@ is similar, and therefore given here.
 319 indexCharOffAddr   :: Addr -> Int -> Char
 320 indexIntOffAddr    :: Addr -> Int -> Int
 321 indexAddrOffAddr   :: Addr -> Int -> Addr
 322 indexFloatOffAddr  :: Addr -> Int -> Float
 323 indexDoubleOffAddr :: Addr -> Int -> Double
 324
 325 indexCharOffAddr (A# addr#) n
 326   = case n                              of { I# n# ->
 327     case indexCharOffAddr# addr# n#     of { r# ->
 328     (C# r#)}}
 329
 330 indexIntOffAddr (A# addr#) n
 331   = case n                              of { I# n# ->
 332     case indexIntOffAddr# addr# n#      of { r# ->
 333     (I# r#)}}
 334
 335 indexAddrOffAddr (A# addr#) n
 336   = case n                              of { I# n# ->
 337     case indexAddrOffAddr# addr# n#     of { r# ->
 338     (A# r#)}}
 339
 340 indexFloatOffAddr (A# addr#) n
 341   = case n                              of { I# n# ->
 342     case indexFloatOffAddr# addr# n#    of { r# ->
 343     (F# r#)}}
 344
 345 indexDoubleOffAddr (A# addr#) n
 346   = case n                              of { I# n# ->
 347     case indexDoubleOffAddr# addr# n#   of { r# ->
 348     (D# r#)}}
 349
 350 writeArray       :: Ix ix => MutableArray s ix elt -> ix -> elt -> ST s ()
 351 writeCharArray   :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s ()
 352 writeIntArray    :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s ()
 353 writeAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s ()
 354 writeFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s ()
 355 writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s ()
 356
 357 {-# SPECIALIZE writeArray       :: MutableArray s Int elt -> Int -> elt -> ST s (),
 358                                    MutableArray s IPr elt -> IPr -> elt -> ST s ()
 359   #-}
 360 {-# SPECIALIZE writeCharArray   :: MutableByteArray s Int -> Int -> Char -> ST s () #-}
 361 {-# SPECIALIZE writeIntArray    :: MutableByteArray s Int -> Int -> Int  -> ST s () #-}
 362 {-# SPECIALIZE writeAddrArray   :: MutableByteArray s Int -> Int -> Addr -> ST s () #-}
 363 --NO:{-# SPECIALIZE writeFloatArray  :: MutableByteArray s Int -> Int -> Float -> ST s () #-}
 364 {-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-}
 365
 366 writeArray (MutableArray ixs arr#) n ele = ST $ \ s# ->
 367     case index ixs n                of { I# n# ->
 368     case writeArray# arr# n# ele s# of { s2# ->
 369     STret s2# () }}
 370
 371 writeCharArray (MutableByteArray ixs barr#) n (C# ele) = ST $ \ s# ->
 372     case (index ixs n)                      of { I# n# ->
 373     case writeCharArray# barr# n# ele s#    of { s2#   ->
 374     STret s2# () }}
 375
 376 writeIntArray (MutableByteArray ixs barr#) n (I# ele) = ST $ \ s# ->
 377     case (index ixs n)                      of { I# n# ->
 378     case writeIntArray# barr# n# ele s#     of { s2#   ->
 379     STret s2# () }}
 380
 381 writeAddrArray (MutableByteArray ixs barr#) n (A# ele) = ST $ \ s# ->
 382     case (index ixs n)                      of { I# n# ->
 383     case writeAddrArray# barr# n# ele s#    of { s2#   ->
 384     STret s2# () }}
 385
 386 writeFloatArray (MutableByteArray ixs barr#) n (F# ele) = ST $ \ s# ->
 387     case (index ixs n)                      of { I# n# ->
 388     case writeFloatArray# barr# n# ele s#   of { s2#   ->
 389     STret s2# () }}
 390
 391 writeDoubleArray (MutableByteArray ixs barr#) n (D# ele) = ST $ \ s# ->
 392     case (index ixs n)                      of { I# n# ->
 393     case writeDoubleArray# barr# n# ele s#  of { s2#   ->
 394     STret s2# () }}
 395 \end{code}
 396
 397
 398 %*********************************************************
 399 %*                                                      *
 400 \subsection{Moving between mutable and immutable}
 401 %*                                                      *
 402 %*********************************************************
 403
 404 \begin{code}
 405 freezeArray       :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
 406 freezeCharArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 407 freezeIntArray    :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 408 freezeAddrArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 409 freezeFloatArray  :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 410 freezeDoubleArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 411
 412 {-# SPECIALISE freezeArray :: MutableArray s Int elt -> ST s (Array Int elt),
 413                               MutableArray s IPr elt -> ST s (Array IPr elt)
 414   #-}
 415 {-# SPECIALISE freezeCharArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
 416
 417 freezeArray (MutableArray ixs arr#) = ST $ \ s# ->
 418     case rangeSize ixs     of { I# n# ->
 419     case freeze arr# n# s# of { StateAndArray# s2# frozen# ->
 420     STret s2# (Array ixs frozen#) }}
 421   where
 422     freeze  :: MutableArray# s ele      -- the thing
 423             -> Int#                     -- size of thing to be frozen
 424             -> State# s                 -- the Universe and everything
 425             -> StateAndArray# s ele
 426
 427     freeze arr# n# s#
 428       = case newArray# n# init s#             of { StateAndMutableArray# s2# newarr1# ->
 429         case copy 0# n# arr# newarr1# s2#     of { StateAndMutableArray# s3# newarr2# ->
 430         unsafeFreezeArray# newarr2# s3#
 431         }}
 432       where
 433         init = error "freezeArray: element not copied"
 434
 435         copy :: Int# -> Int#
 436              -> MutableArray# s ele -> MutableArray# s ele
 437              -> State# s
 438              -> StateAndMutableArray# s ele
 439
 440         copy cur# end# from# to# s#
 441           | cur# ==# end#
 442             = StateAndMutableArray# s# to#
 443           | otherwise
 444             = case readArray#  from# cur#     s#  of { StateAndPtr# s1# ele ->
 445               case writeArray# to#   cur# ele s1# of { s2# ->
 446               copy (cur# +# 1#) end# from# to# s2#
 447               }}
 448
 449 freezeCharArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 450     case rangeSize ixs     of { I# n# ->
 451     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 452     STret s2# (ByteArray ixs frozen#) }}
 453   where
 454     freeze  :: MutableByteArray# s      -- the thing
 455             -> Int#                     -- size of thing to be frozen
 456             -> State# s                 -- the Universe and everything
 457             -> StateAndByteArray# s
 458
 459     freeze arr# n# s#
 460       = case (newCharArray# n# s#)         of { StateAndMutableByteArray# s2# newarr1# ->
 461         case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
 462         unsafeFreezeByteArray# newarr2# s3#
 463         }}
 464       where
 465         copy :: Int# -> Int#
 466              -> MutableByteArray# s -> MutableByteArray# s
 467              -> State# s
 468              -> StateAndMutableByteArray# s
 469
 470         copy cur# end# from# to# s#
 471           | cur# ==# end#
 472             = StateAndMutableByteArray# s# to#
 473           | otherwise
 474             = case (readCharArray#  from# cur#     s#)  of { StateAndChar# s1# ele ->
 475               case (writeCharArray# to#   cur# ele s1#) of { s2# ->
 476               copy (cur# +# 1#) end# from# to# s2#
 477               }}
 478
 479 freezeIntArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 480     case rangeSize ixs     of { I# n# ->
 481     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 482     STret s2# (ByteArray ixs frozen#) }}
 483   where
 484     freeze  :: MutableByteArray# s      -- the thing
 485             -> Int#                     -- size of thing to be frozen
 486             -> State# s                 -- the Universe and everything
 487             -> StateAndByteArray# s
 488
 489     freeze arr# n# s#
 490       = case (newIntArray# n# s#)          of { StateAndMutableByteArray# s2# newarr1# ->
 491         case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
 492         unsafeFreezeByteArray# newarr2# s3#
 493         }}
 494       where
 495         copy :: Int# -> Int#
 496              -> MutableByteArray# s -> MutableByteArray# s
 497              -> State# s
 498              -> StateAndMutableByteArray# s
 499
 500         copy cur# end# from# to# s#
 501           | cur# ==# end#
 502             = StateAndMutableByteArray# s# to#
 503           | otherwise
 504             = case (readIntArray#  from# cur#     s#)  of { StateAndInt# s1# ele ->
 505               case (writeIntArray# to#   cur# ele s1#) of { s2# ->
 506               copy (cur# +# 1#) end# from# to# s2#
 507               }}
 508
 509 freezeAddrArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 510     case rangeSize ixs     of { I# n# ->
 511     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 512     STret s2# (ByteArray ixs frozen#) }}
 513   where
 514     freeze  :: MutableByteArray# s      -- the thing
 515             -> Int#                     -- size of thing to be frozen
 516             -> State# s                 -- the Universe and everything
 517             -> StateAndByteArray# s
 518
 519     freeze arr# n# s#
 520       = case (newAddrArray# n# s#)         of { StateAndMutableByteArray# s2# newarr1# ->
 521         case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
 522         unsafeFreezeByteArray# newarr2# s3#
 523         }}
 524       where
 525         copy :: Int# -> Int#
 526              -> MutableByteArray# s -> MutableByteArray# s
 527              -> State# s
 528              -> StateAndMutableByteArray# s
 529
 530         copy cur# end# from# to# s#
 531           | cur# ==# end#
 532             = StateAndMutableByteArray# s# to#
 533           | otherwise
 534             = case (readAddrArray#  from# cur#     s#)  of { StateAndAddr# s1# ele ->
 535               case (writeAddrArray# to#   cur# ele s1#) of { s2# ->
 536               copy (cur# +# 1#) end# from# to# s2#
 537               }}
 538
 539 freezeFloatArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 540     case rangeSize ixs     of { I# n# ->
 541     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 542     STret s2# (ByteArray ixs frozen#) }}
 543   where
 544     freeze  :: MutableByteArray# s      -- the thing
 545             -> Int#                     -- size of thing to be frozen
 546             -> State# s                 -- the Universe and everything
 547             -> StateAndByteArray# s
 548
 549     freeze arr# end# s#
 550       = case (newFloatArray# end# s#)   of { StateAndMutableByteArray# s2# newarr1# ->
 551         case copy 0# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
 552         unsafeFreezeByteArray# newarr2# s3#
 553         }}
 554       where
 555         copy :: Int#
 556              -> MutableByteArray# s -> MutableByteArray# s
 557              -> State# s
 558              -> StateAndMutableByteArray# s
 559
 560         copy cur# from# to# s#
 561           | cur# ==# end#
 562             = StateAndMutableByteArray# s# to#
 563           | otherwise
 564             = case (readFloatArray#  from# cur#     s#)  of { StateAndFloat# s1# ele ->
 565               case (writeFloatArray# to#   cur# ele s1#) of { s2# ->
 566               copy (cur# +# 1#) from# to# s2#
 567               }}
 568
 569 freezeDoubleArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 570     case rangeSize ixs     of { I# n# ->
 571     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 572     STret s2# (ByteArray ixs frozen#) }}
 573   where
 574     freeze  :: MutableByteArray# s      -- the thing
 575             -> Int#                     -- size of thing to be frozen
 576             -> State# s                 -- the Universe and everything
 577             -> StateAndByteArray# s
 578
 579     freeze arr# n# s#
 580       = case (newDoubleArray# n# s#)       of { StateAndMutableByteArray# s2# newarr1# ->
 581         case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
 582         unsafeFreezeByteArray# newarr2# s3#
 583         }}
 584       where
 585         copy :: Int# -> Int#
 586              -> MutableByteArray# s -> MutableByteArray# s
 587              -> State# s
 588              -> StateAndMutableByteArray# s
 589
 590         copy cur# end# from# to# s#
 591           | cur# ==# end#
 592             = StateAndMutableByteArray# s# to#
 593           | otherwise
 594             = case (readDoubleArray#  from# cur#     s#)  of { StateAndDouble# s1# ele ->
 595               case (writeDoubleArray# to#   cur# ele s1#) of { s2# ->
 596               copy (cur# +# 1#) end# from# to# s2#
 597               }}
 598
 599 unsafeFreezeArray     :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
 600 unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 601
 602 {-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
 603   #-}
 604
 605 unsafeFreezeArray (MutableArray ixs arr#) = ST $ \ s# ->
 606     case unsafeFreezeArray# arr# s# of { StateAndArray# s2# frozen# ->
 607     STret s2# (Array ixs frozen#) }
 608
 609 unsafeFreezeByteArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 610     case unsafeFreezeByteArray# arr# s# of { StateAndByteArray# s2# frozen# ->
 611     STret s2# (ByteArray ixs frozen#) }
 612
 613
 614 --This takes a immutable array, and copies it into a mutable array, in a
 615 --hurry.
 616
 617 {-# SPECIALISE thawArray :: Array Int elt -> ST s (MutableArray s Int elt),
 618                             Array IPr elt -> ST s (MutableArray s IPr elt)
 619   #-}
 620
 621 thawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
 622 thawArray (Array ixs arr#) = ST $ \ s# ->
 623     case rangeSize ixs     of { I# n# ->
 624     case thaw arr# n# s# of { StateAndMutableArray# s2# thawed# ->
 625     STret s2# (MutableArray ixs thawed#)}}
 626   where
 627     thaw  :: Array# ele                 -- the thing
 628             -> Int#                     -- size of thing to be thawed
 629             -> State# s                 -- the Universe and everything
 630             -> StateAndMutableArray# s ele
 631
 632     thaw arr# n# s#
 633       = case newArray# n# init s#             of { StateAndMutableArray# s2# newarr1# ->
 634         copy 0# n# arr# newarr1# s2# }
 635       where
 636         init = error "thawArray: element not copied"
 637
 638         copy :: Int# -> Int#
 639              -> Array# ele
 640              -> MutableArray# s ele
 641              -> State# s
 642              -> StateAndMutableArray# s ele
 643
 644         copy cur# end# from# to# s#
 645           | cur# ==# end#
 646             = StateAndMutableArray# s# to#
 647           | otherwise
 648             = case indexArray#  from# cur#       of { Lift ele ->
 649               case writeArray# to#   cur# ele s# of { s1# ->
 650               copy (cur# +# 1#) end# from# to# s1#
 651               }}
 652 \end{code}
 653
 654 %*********************************************************
 655 %*                                                      *
 656 \subsection{Ghastly return types}
 657 %*                                                      *
 658 %*********************************************************
 659
 660 \begin{code}
 661 data StateAndArray#            s elt = StateAndArray#        (State# s) (Array# elt)
 662 data StateAndMutableArray#     s elt = StateAndMutableArray# (State# s) (MutableArray# s elt)
 663 data StateAndByteArray#        s = StateAndByteArray#        (State# s) ByteArray#
 664 data StateAndMutableByteArray# s = StateAndMutableByteArray# (State# s) (MutableByteArray# s)
 665 \end{code}