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