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