ghc/lib/std/PrelArr.lhs

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