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 { (arr@(MutableArray _ arr#),s) ->
  94         let
  95          fill_one_in (S# s#) (i, v)
  96              = case index ixs  i                of { I# n# ->
  97                case writeArray# arr# n# v s#    of { s2#   ->
  98                S# s2# }}
  99         in
 100         case (foldl fill_one_in s ivs)          of { s@(S# _) ->
 101         case (freezeArray arr)                  of { ST freeze_array_thing ->
 102         freeze_array_thing s }}}})
 103
 104 arrEleBottom = error "(Array.!): undefined array element"
 105
 106 fill_it_in :: Ix ix => MutableArray s ix elt -> [(ix, elt)] -> ST s ()
 107 fill_it_in arr lst
 108   = foldr fill_one_in (returnST ()) lst
 109   where  -- **** STRICT **** (but that's OK...)
 110     fill_one_in (i, v) rst
 111       = writeArray arr i v `seqST` rst
 112
 113 -----------------------------------------------------------------------
 114 -- these also go better with magic: (//), accum, accumArray
 115
 116 old_array // ivs
 117   = runST (
 118         -- copy the old array:
 119         thawArray old_array                 `thenST` \ arr ->
 120         -- now write the new elements into the new array:
 121         fill_it_in arr ivs                  `seqST`
 122         freezeArray arr
 123     )
 124   where
 125     bottom = error "(Array.//): error in copying old array\n"
 126
 127 zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> MutableArray s ix elt -> [(ix,elt2)] -> ST s ()
 128 -- zap_with_f: reads an elem out first, then uses "f" on that and the new value
 129
 130 zap_with_f f arr lst
 131   = foldr zap_one (returnST ()) lst
 132   where
 133     zap_one (i, new_v) rst
 134       = readArray  arr i                 `thenST`  \ old_v ->
 135         writeArray arr i (f old_v new_v) `seqST`
 136         rst
 137
 138 accum f old_array ivs
 139   = runST (
 140         -- copy the old array:
 141         thawArray old_array                 `thenST` \ arr ->
 142
 143         -- now zap the elements in question with "f":
 144         zap_with_f f arr ivs            >>
 145         freezeArray arr
 146     )
 147   where
 148     bottom = error "Array.accum: error in copying old array\n"
 149
 150 accumArray f zero ixs ivs
 151   = runST (
 152         newArray ixs zero       >>= \ arr# ->
 153         zap_with_f f  arr# ivs  >>
 154         freezeArray arr#
 155     )
 156 \end{code}
 157
 158
 159 %*********************************************************
 160 %*                                                      *
 161 \subsection{Operations on mutable arrays}
 162 %*                                                      *
 163 %*********************************************************
 164
 165 Idle ADR question: What's the tradeoff here between flattening these
 166 datatypes into @MutableArray ix ix (MutableArray# s elt)@ and using
 167 it as is?  As I see it, the former uses slightly less heap and
 168 provides faster access to the individual parts of the bounds while the
 169 code used has the benefit of providing a ready-made @(lo, hi)@ pair as
 170 required by many array-related functions.  Which wins? Is the
 171 difference significant (probably not).
 172
 173 Idle AJG answer: When I looked at the outputted code (though it was 2
 174 years ago) it seems like you often needed the tuple, and we build
 175 it frequently. Now we've got the overloading specialiser things
 176 might be different, though.
 177
 178 \begin{code}
 179 newArray :: Ix ix => (ix,ix) -> elt -> ST s (MutableArray s ix elt)
 180 newCharArray, newIntArray, newAddrArray, newFloatArray, newDoubleArray
 181          :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
 182
 183 {-# SPECIALIZE newArray      :: IPr       -> elt -> ST s (MutableArray s Int elt),
 184                                 (IPr,IPr) -> elt -> ST s (MutableArray s IPr elt)
 185   #-}
 186 {-# SPECIALIZE newCharArray   :: IPr -> ST s (MutableByteArray s Int) #-}
 187 {-# SPECIALIZE newIntArray    :: IPr -> ST s (MutableByteArray s Int) #-}
 188 {-# SPECIALIZE newAddrArray   :: IPr -> ST s (MutableByteArray s Int) #-}
 189 {-# SPECIALIZE newFloatArray  :: IPr -> ST s (MutableByteArray s Int) #-}
 190 {-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-}
 191
 192 newArray ixs init = ST $ \ (S# s#) ->
 193     case rangeSize ixs              of { I# n# ->
 194     case (newArray# n# init s#)     of { StateAndMutableArray# s2# arr# ->
 195     (MutableArray ixs arr#, S# s2#)}}
 196
 197 newCharArray ixs = ST $ \ (S# s#) ->
 198     case rangeSize ixs              of { I# n# ->
 199     case (newCharArray# n# s#)    of { StateAndMutableByteArray# s2# barr# ->
 200     (MutableByteArray ixs barr#, S# s2#)}}
 201
 202 newIntArray ixs = ST $ \ (S# s#) ->
 203     case rangeSize ixs              of { I# n# ->
 204     case (newIntArray# n# s#)     of { StateAndMutableByteArray# s2# barr# ->
 205     (MutableByteArray ixs barr#, S# s2#)}}
 206
 207 newAddrArray ixs = ST $ \ (S# s#) ->
 208     case rangeSize ixs              of { I# n# ->
 209     case (newAddrArray# n# s#)    of { StateAndMutableByteArray# s2# barr# ->
 210     (MutableByteArray ixs barr#, S# s2#)}}
 211
 212 newFloatArray ixs = ST $ \ (S# s#) ->
 213     case rangeSize ixs              of { I# n# ->
 214     case (newFloatArray# n# s#)   of { StateAndMutableByteArray# s2# barr# ->
 215     (MutableByteArray ixs barr#, S# s2#)}}
 216
 217 newDoubleArray ixs = ST $ \ (S# s#) ->
 218     case rangeSize ixs              of { I# n# ->
 219     case (newDoubleArray# n# s#)  of { StateAndMutableByteArray# s2# barr# ->
 220     (MutableByteArray ixs barr#, S# s2#)}}
 221
 222 boundsOfArray     :: Ix ix => MutableArray s ix elt -> (ix, ix)
 223 boundsOfByteArray :: Ix ix => MutableByteArray s ix -> (ix, ix)
 224
 225 {-# SPECIALIZE boundsOfArray     :: MutableArray s Int elt -> IPr #-}
 226 {-# SPECIALIZE boundsOfByteArray :: MutableByteArray s Int -> IPr #-}
 227
 228 boundsOfArray     (MutableArray     ixs _) = ixs
 229 boundsOfByteArray (MutableByteArray ixs _) = ixs
 230
 231 readArray       :: Ix ix => MutableArray s ix elt -> ix -> ST s elt
 232
 233 readCharArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Char
 234 readIntArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
 235 readAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr
 236 readFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
 237 readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
 238
 239 {-# SPECIALIZE readArray       :: MutableArray s Int elt -> Int -> ST s elt,
 240                                   MutableArray s IPr elt -> IPr -> ST s elt
 241   #-}
 242 {-# SPECIALIZE readCharArray   :: MutableByteArray s Int -> Int -> ST s Char #-}
 243 {-# SPECIALIZE readIntArray    :: MutableByteArray s Int -> Int -> ST s Int #-}
 244 {-# SPECIALIZE readAddrArray   :: MutableByteArray s Int -> Int -> ST s Addr #-}
 245 --NO:{-# SPECIALIZE readFloatArray  :: MutableByteArray s Int -> Int -> ST s Float #-}
 246 {-# SPECIALIZE readDoubleArray :: MutableByteArray s Int -> Int -> ST s Double #-}
 247
 248 readArray (MutableArray ixs arr#) n = ST $ \ (S# s#) ->
 249     case (index ixs n)          of { I# n# ->
 250     case readArray# arr# n# s#  of { StateAndPtr# s2# r ->
 251     (r, S# s2#)}}
 252
 253 readCharArray (MutableByteArray ixs barr#) n = ST $ \ (S# s#) ->
 254     case (index ixs n)                  of { I# n# ->
 255     case readCharArray# barr# n# s#     of { StateAndChar# s2# r# ->
 256     (C# r#, S# s2#)}}
 257
 258 readIntArray (MutableByteArray ixs barr#) n = ST $ \ (S# s#) ->
 259     case (index ixs n)                  of { I# n# ->
 260     case readIntArray# barr# n# s#      of { StateAndInt# s2# r# ->
 261     (I# r#, S# s2#)}}
 262
 263 readAddrArray (MutableByteArray ixs barr#) n = ST $ \ (S# s#) ->
 264     case (index ixs n)                  of { I# n# ->
 265     case readAddrArray# barr# n# s#     of { StateAndAddr# s2# r# ->
 266     (A# r#, S# s2#)}}
 267
 268 readFloatArray (MutableByteArray ixs barr#) n = ST $ \ (S# s#) ->
 269     case (index ixs n)                  of { I# n# ->
 270     case readFloatArray# barr# n# s#    of { StateAndFloat# s2# r# ->
 271     (F# r#, S# s2#)}}
 272
 273 readDoubleArray (MutableByteArray ixs barr#) n = ST $ \ (S# s#) ->
 274     case (index ixs n)                  of { I# n# ->
 275     case readDoubleArray# barr# n# s#   of { StateAndDouble# s2# r# ->
 276     (D# r#, S# s2#)}}
 277
 278 --Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
 279 indexCharArray   :: Ix ix => ByteArray ix -> ix -> Char
 280 indexIntArray    :: Ix ix => ByteArray ix -> ix -> Int
 281 indexAddrArray   :: Ix ix => ByteArray ix -> ix -> Addr
 282 indexFloatArray  :: Ix ix => ByteArray ix -> ix -> Float
 283 indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double
 284
 285 {-# SPECIALIZE indexCharArray   :: ByteArray Int -> Int -> Char #-}
 286 {-# SPECIALIZE indexIntArray    :: ByteArray Int -> Int -> Int #-}
 287 {-# SPECIALIZE indexAddrArray   :: ByteArray Int -> Int -> Addr #-}
 288 --NO:{-# SPECIALIZE indexFloatArray  :: ByteArray Int -> Int -> Float #-}
 289 {-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-}
 290
 291 indexCharArray (ByteArray ixs barr#) n
 292   = case (index ixs n)                  of { I# n# ->
 293     case indexCharArray# barr# n#       of { r# ->
 294     (C# r#)}}
 295
 296 indexIntArray (ByteArray ixs barr#) n
 297   = case (index ixs n)                  of { I# n# ->
 298     case indexIntArray# barr# n#        of { r# ->
 299     (I# r#)}}
 300
 301 indexAddrArray (ByteArray ixs barr#) n
 302   = case (index ixs n)                  of { I# n# ->
 303     case indexAddrArray# barr# n#       of { r# ->
 304     (A# r#)}}
 305
 306 indexFloatArray (ByteArray ixs barr#) n
 307   = case (index ixs n)                  of { I# n# ->
 308     case indexFloatArray# barr# n#      of { r# ->
 309     (F# r#)}}
 310
 311 indexDoubleArray (ByteArray ixs barr#) n
 312   = case (index ixs n)                  of { I# n# ->
 313     case indexDoubleArray# barr# n#     of { r# ->
 314     (D# r#)}}
 315
 316 --Indexing off @Addrs@ is similar, and therefore given here.
 317 indexCharOffAddr   :: Addr -> Int -> Char
 318 indexIntOffAddr    :: Addr -> Int -> Int
 319 indexAddrOffAddr   :: Addr -> Int -> Addr
 320 indexFloatOffAddr  :: Addr -> Int -> Float
 321 indexDoubleOffAddr :: Addr -> Int -> Double
 322
 323 indexCharOffAddr (A# addr#) n
 324   = case n                              of { I# n# ->
 325     case indexCharOffAddr# addr# n#     of { r# ->
 326     (C# r#)}}
 327
 328 indexIntOffAddr (A# addr#) n
 329   = case n                              of { I# n# ->
 330     case indexIntOffAddr# addr# n#      of { r# ->
 331     (I# r#)}}
 332
 333 indexAddrOffAddr (A# addr#) n
 334   = case n                              of { I# n# ->
 335     case indexAddrOffAddr# addr# n#     of { r# ->
 336     (A# r#)}}
 337
 338 indexFloatOffAddr (A# addr#) n
 339   = case n                              of { I# n# ->
 340     case indexFloatOffAddr# addr# n#    of { r# ->
 341     (F# r#)}}
 342
 343 indexDoubleOffAddr (A# addr#) n
 344   = case n                              of { I# n# ->
 345     case indexDoubleOffAddr# addr# n#   of { r# ->
 346     (D# r#)}}
 347
 348 writeArray       :: Ix ix => MutableArray s ix elt -> ix -> elt -> ST s ()
 349 writeCharArray   :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s ()
 350 writeIntArray    :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s ()
 351 writeAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s ()
 352 writeFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s ()
 353 writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s ()
 354
 355 {-# SPECIALIZE writeArray       :: MutableArray s Int elt -> Int -> elt -> ST s (),
 356                                    MutableArray s IPr elt -> IPr -> elt -> ST s ()
 357   #-}
 358 {-# SPECIALIZE writeCharArray   :: MutableByteArray s Int -> Int -> Char -> ST s () #-}
 359 {-# SPECIALIZE writeIntArray    :: MutableByteArray s Int -> Int -> Int  -> ST s () #-}
 360 {-# SPECIALIZE writeAddrArray   :: MutableByteArray s Int -> Int -> Addr -> ST s () #-}
 361 --NO:{-# SPECIALIZE writeFloatArray  :: MutableByteArray s Int -> Int -> Float -> ST s () #-}
 362 {-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-}
 363
 364 writeArray (MutableArray ixs arr#) n ele = ST $ \ (S# s#) ->
 365     case index ixs n                of { I# n# ->
 366     case writeArray# arr# n# ele s# of { s2# ->
 367     ((), S# s2#)}}
 368
 369 writeCharArray (MutableByteArray ixs barr#) n (C# ele) = ST $ \ (S# s#) ->
 370     case (index ixs n)                      of { I# n# ->
 371     case writeCharArray# barr# n# ele s#    of { s2#   ->
 372     ((), S# s2#)}}
 373
 374 writeIntArray (MutableByteArray ixs barr#) n (I# ele) = ST $ \ (S# s#) ->
 375     case (index ixs n)                      of { I# n# ->
 376     case writeIntArray# barr# n# ele s#     of { s2#   ->
 377     ((), S# s2#)}}
 378
 379 writeAddrArray (MutableByteArray ixs barr#) n (A# ele) = ST $ \ (S# s#) ->
 380     case (index ixs n)                      of { I# n# ->
 381     case writeAddrArray# barr# n# ele s#    of { s2#   ->
 382     ((), S# s2#)}}
 383
 384 writeFloatArray (MutableByteArray ixs barr#) n (F# ele) = ST $ \ (S# s#) ->
 385     case (index ixs n)                      of { I# n# ->
 386     case writeFloatArray# barr# n# ele s#   of { s2#   ->
 387     ((), S# s2#)}}
 388
 389 writeDoubleArray (MutableByteArray ixs barr#) n (D# ele) = ST $ \ (S# s#) ->
 390     case (index ixs n)                      of { I# n# ->
 391     case writeDoubleArray# barr# n# ele s#  of { s2#   ->
 392     ((), S# s2#)}}
 393 \end{code}
 394
 395
 396 %*********************************************************
 397 %*                                                      *
 398 \subsection{Moving between mutable and immutable}
 399 %*                                                      *
 400 %*********************************************************
 401
 402 \begin{code}
 403 freezeArray       :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
 404 freezeCharArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 405 freezeIntArray    :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 406 freezeAddrArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 407 freezeFloatArray  :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 408 freezeDoubleArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 409
 410 {-# SPECIALISE freezeArray :: MutableArray s Int elt -> ST s (Array Int elt),
 411                               MutableArray s IPr elt -> ST s (Array IPr elt)
 412   #-}
 413 {-# SPECIALISE freezeCharArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
 414
 415 freezeArray (MutableArray ixs arr#) = ST $ \ (S# s#) ->
 416     case rangeSize ixs     of { I# n# ->
 417     case freeze arr# n# s# of { StateAndArray# s2# frozen# ->
 418     (Array ixs frozen#, S# s2#)}}
 419   where
 420     freeze  :: MutableArray# s ele      -- the thing
 421             -> Int#                     -- size of thing to be frozen
 422             -> State# s                 -- the Universe and everything
 423             -> StateAndArray# s ele
 424
 425     freeze arr# n# s#
 426       = case newArray# n# init s#             of { StateAndMutableArray# s2# newarr1# ->
 427         case copy 0# n# arr# newarr1# s2#     of { StateAndMutableArray# s3# newarr2# ->
 428         unsafeFreezeArray# newarr2# s3#
 429         }}
 430       where
 431         init = error "freezeArray: element not copied"
 432
 433         copy :: Int# -> Int#
 434              -> MutableArray# s ele -> MutableArray# s ele
 435              -> State# s
 436              -> StateAndMutableArray# s ele
 437
 438         copy cur# end# from# to# s#
 439           | cur# ==# end#
 440             = StateAndMutableArray# s# to#
 441           | otherwise
 442             = case readArray#  from# cur#     s#  of { StateAndPtr# s1# ele ->
 443               case writeArray# to#   cur# ele s1# of { s2# ->
 444               copy (cur# +# 1#) end# from# to# s2#
 445               }}
 446
 447 freezeCharArray (MutableByteArray ixs arr#) = ST $ \ (S# s#) ->
 448     case rangeSize ixs     of { I# n# ->
 449     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 450     (ByteArray ixs frozen#, S# s2#) }}
 451   where
 452     freeze  :: MutableByteArray# s      -- the thing
 453             -> Int#                     -- size of thing to be frozen
 454             -> State# s                 -- the Universe and everything
 455             -> StateAndByteArray# s
 456
 457     freeze arr# n# s#
 458       = case (newCharArray# n# s#)         of { StateAndMutableByteArray# s2# newarr1# ->
 459         case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
 460         unsafeFreezeByteArray# newarr2# s3#
 461         }}
 462       where
 463         copy :: Int# -> Int#
 464              -> MutableByteArray# s -> MutableByteArray# s
 465              -> State# s
 466              -> StateAndMutableByteArray# s
 467
 468         copy cur# end# from# to# s#
 469           | cur# ==# end#
 470             = StateAndMutableByteArray# s# to#
 471           | otherwise
 472             = case (readCharArray#  from# cur#     s#)  of { StateAndChar# s1# ele ->
 473               case (writeCharArray# to#   cur# ele s1#) of { s2# ->
 474               copy (cur# +# 1#) end# from# to# s2#
 475               }}
 476
 477 freezeIntArray (MutableByteArray ixs arr#) = ST $ \ (S# s#) ->
 478     case rangeSize ixs     of { I# n# ->
 479     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 480     (ByteArray ixs frozen#, S# s2#) }}
 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 (newIntArray# 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 (readIntArray#  from# cur#     s#)  of { StateAndInt# s1# ele ->
 503               case (writeIntArray# to#   cur# ele s1#) of { s2# ->
 504               copy (cur# +# 1#) end# from# to# s2#
 505               }}
 506
 507 freezeAddrArray (MutableByteArray ixs arr#) = ST $ \ (S# s#) ->
 508     case rangeSize ixs     of { I# n# ->
 509     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 510     (ByteArray ixs frozen#, S# s2#) }}
 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 (newAddrArray# 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 (readAddrArray#  from# cur#     s#)  of { StateAndAddr# s1# ele ->
 533               case (writeAddrArray# to#   cur# ele s1#) of { s2# ->
 534               copy (cur# +# 1#) end# from# to# s2#
 535               }}
 536
 537 freezeFloatArray (MutableByteArray ixs arr#) = ST $ \ (S# s#) ->
 538     case rangeSize ixs     of { I# n# ->
 539     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 540     (ByteArray ixs frozen#, S# s2#) }}
 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# end# s#
 548       = case (newFloatArray# end# s#)   of { StateAndMutableByteArray# s2# newarr1# ->
 549         case copy 0# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
 550         unsafeFreezeByteArray# newarr2# s3#
 551         }}
 552       where
 553         copy :: Int#
 554              -> MutableByteArray# s -> MutableByteArray# s
 555              -> State# s
 556              -> StateAndMutableByteArray# s
 557
 558         copy cur# from# to# s#
 559           | cur# ==# end#
 560             = StateAndMutableByteArray# s# to#
 561           | otherwise
 562             = case (readFloatArray#  from# cur#     s#)  of { StateAndFloat# s1# ele ->
 563               case (writeFloatArray# to#   cur# ele s1#) of { s2# ->
 564               copy (cur# +# 1#) from# to# s1#
 565               }
 566
 567 freezeDoubleArray (MutableByteArray ixs arr#) = ST $ \ (S# s#) ->
 568     case rangeSize ixs     of { I# n# ->
 569     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 570     (ByteArray ixs frozen#, S# s2#) }}
 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 (newDoubleArray# 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 (readDoubleArray#  from# cur#     s#)  of { StateAndDouble# s1# ele ->
 593               case (writeDoubleArray# to#   cur# ele s1#) of { s2# ->
 594               copy (cur# +# 1#) end# from# to# s1#
 595               }
 596
 597 unsafeFreezeArray     :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
 598 unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 599
 600 {-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
 601   #-}
 602
 603 unsafeFreezeArray (MutableArray ixs arr#) = ST $ \ (S# s#) ->
 604     case unsafeFreezeArray# arr# s# of { StateAndArray# s2# frozen# ->
 605     (Array ixs frozen#, S# s2#) }
 606
 607 unsafeFreezeByteArray (MutableByteArray ixs arr#) = ST $ \ (S# s#) ->
 608     case unsafeFreezeByteArray# arr# s# of { StateAndByteArray# s2# frozen# ->
 609     (ByteArray ixs frozen#, S# s2#) }
 610
 611
 612 --This takes a immutable array, and copies it into a mutable array, in a
 613 --hurry.
 614
 615 {-# SPECIALISE thawArray :: Array Int elt -> ST s (MutableArray s Int elt),
 616                             Array IPr elt -> ST s (MutableArray s IPr elt)
 617   #-}
 618
 619 thawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
 620 thawArray (Array ixs arr#) = ST $ \ (S# s#) ->
 621     case rangeSize ixs     of { I# n# ->
 622     case thaw arr# n# s# of { StateAndMutableArray# s2# thawed# ->
 623     (MutableArray ixs thawed#, S# s2#)}}
 624   where
 625     thaw  :: Array# ele                 -- the thing
 626             -> Int#                     -- size of thing to be thawed
 627             -> State# s                 -- the Universe and everything
 628             -> StateAndMutableArray# s ele
 629
 630     thaw arr# n# s#
 631       = case newArray# n# init s#             of { StateAndMutableArray# s2# newarr1# ->
 632         copy 0# n# arr# newarr1# s2# }
 633       where
 634         init = error "thawArray: element not copied"
 635
 636         copy :: Int# -> Int#
 637              -> Array# ele
 638              -> MutableArray# s ele
 639              -> State# s
 640              -> StateAndMutableArray# s ele
 641
 642         copy cur# end# from# to# s#
 643           | cur# ==# end#
 644             = StateAndMutableArray# s# to#
 645           | otherwise
 646             = case indexArray#  from# cur#       of { Lift ele ->
 647               case writeArray# to#   cur# ele s# of { s1# ->
 648               copy (cur# +# 1#) end# from# to# s1#
 649               }}
 650 \end{code}
 651
 652 %*********************************************************
 653 %*                                                      *
 654 \subsection{Ghastly return types}
 655 %*                                                      *
 656 %*********************************************************
 657
 658 \begin{code}
 659 data StateAndArray#            s elt = StateAndArray#        (State# s) (Array# elt)
 660 data StateAndMutableArray#     s elt = StateAndMutableArray# (State# s) (MutableArray# s elt)
 661 data StateAndByteArray#        s = StateAndByteArray#        (State# s) ByteArray#
 662 data StateAndMutableByteArray# s = StateAndMutableByteArray# (State# s) (MutableByteArray# s)
 663 \end{code}