ghc/lib/std/PrelArr.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: PrelArr.lhs,v 1.25 2000/08/31 19:57:42 simonpj Exp $
   3 %
   4 % (c) The University of Glasgow, 1994-2000
   5 %
   6
   7 \section[PrelArr]{Module @PrelArr@}
   8
   9 Array implementation, @PrelArr@ exports the basic array
  10 types and operations.
  11
  12 For byte-arrays see @PrelByteArr@.
  13
  14 \begin{code}
  15 {-# OPTIONS -fno-implicit-prelude #-}
  16
  17 module PrelArr where
  18
  19 import {-# SOURCE #-} PrelErr ( error )
  20 import PrelEnum
  21 import PrelNum
  22 import PrelST
  23 import PrelBase
  24 import PrelShow
  25
  26 infixl 9  !, //
  27
  28 default ()
  29 \end{code}
  30
  31
  32 %*********************************************************
  33 %*                                                      *
  34 \subsection{The @Ix@ class}
  35 %*                                                      *
  36 %*********************************************************
  37
  38 \begin{code}
  39 class  (Ord a) => Ix a  where
  40     range               :: (a,a) -> [a]
  41     index, unsafeIndex  :: (a,a) -> a -> Int
  42     inRange             :: (a,a) -> a -> Bool
  43
  44         -- Must specify one of index, unsafeIndex
  45     index b i | inRange b i = unsafeIndex b i
  46               | otherwise   = error "Error in array index"
  47     unsafeIndex b i = index b i
  48 \end{code}
  49
  50
  51 %*********************************************************
  52 %*                                                      *
  53 \subsection{Instances of @Ix@}
  54 %*                                                      *
  55 %*********************************************************
  56
  57 \begin{code}
  58 -- abstract these errors from the relevant index functions so that
  59 -- the guts of the function will be small enough to inline.
  60
  61 {-# NOINLINE indexError #-}
  62 indexError :: Show a => (a,a) -> a -> String -> b
  63 indexError rng i tp
  64   = error (showString "Ix{" . showString tp . showString "}.index: Index " .
  65            showParen True (showsPrec 0 i) .
  66            showString " out of range " $
  67            showParen True (showsPrec 0 rng) "")
  68
  69 ----------------------------------------------------------------------
  70 instance  Ix Char  where
  71     {-# INLINE range #-}
  72     range (m,n) = [m..n]
  73
  74     {-# INLINE unsafeIndex #-}
  75     unsafeIndex (m,_n) i = fromEnum i - fromEnum m
  76
  77     index b i | inRange b i =  unsafeIndex b i
  78               | otherwise   =  indexError b i "Char"
  79
  80     inRange (m,n) i     =  m <= i && i <= n
  81
  82 ----------------------------------------------------------------------
  83 instance  Ix Int  where
  84     {-# INLINE range #-}
  85         -- The INLINE stops the build in the RHS from getting inlined,
  86         -- so that callers can fuse with the result of range
  87     range (m,n) = [m..n]
  88
  89     {-# INLINE unsafeIndex #-}
  90     unsafeIndex (m,_n) i = i - m
  91
  92     index b i | inRange b i =  unsafeIndex b i
  93               | otherwise   =  indexError b i "Int"
  94
  95     {-# INLINE inRange #-}
  96     inRange (I# m,I# n) (I# i) =  m <=# i && i <=# n
  97
  98 ----------------------------------------------------------------------
  99 instance  Ix Integer  where
 100     {-# INLINE range #-}
 101     range (m,n) = [m..n]
 102
 103     {-# INLINE unsafeIndex #-}
 104     unsafeIndex (m,_n) i   = fromInteger (i - m)
 105
 106     index b i | inRange b i =  unsafeIndex b i
 107               | otherwise   =  indexError b i "Integer"
 108
 109     inRange (m,n) i     =  m <= i && i <= n
 110
 111
 112 ----------------------------------------------------------------------
 113 instance Ix Bool where -- as derived
 114     {-# INLINE range #-}
 115     range (m,n) = [m..n]
 116
 117     {-# INLINE unsafeIndex #-}
 118     unsafeIndex (l,_) i = fromEnum i - fromEnum l
 119
 120     index b i | inRange b i =  unsafeIndex b i
 121               | otherwise   =  indexError b i "Bool"
 122
 123     inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
 124
 125 ----------------------------------------------------------------------
 126 instance Ix Ordering where -- as derived
 127     {-# INLINE range #-}
 128     range (m,n) = [m..n]
 129
 130     {-# INLINE unsafeIndex #-}
 131     unsafeIndex (l,_) i = fromEnum i - fromEnum l
 132
 133     index b i | inRange b i =  unsafeIndex b i
 134               | otherwise   =  indexError b i "Ordering"
 135
 136     inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
 137
 138 ----------------------------------------------------------------------
 139 instance Ix () where
 140     {-# INLINE range #-}
 141     range   ((), ())    = [()]
 142     {-# INLINE unsafeIndex #-}
 143     unsafeIndex   ((), ()) () = 0
 144     {-# INLINE inRange #-}
 145     inRange ((), ()) () = True
 146     {-# INLINE index #-}
 147     index b i = unsafeIndex b i
 148
 149
 150 ----------------------------------------------------------------------
 151 instance (Ix a, Ix b) => Ix (a, b) where -- as derived
 152     {-# SPECIALISE instance Ix (Int,Int) #-}
 153
 154     {- INLINE range #-}
 155     range ((l1,l2),(u1,u2)) =
 156       [ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ]
 157
 158     {- INLINE unsafeIndex #-}
 159     unsafeIndex ((l1,l2),(u1,u2)) (i1,i2) =
 160       unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2
 161
 162     {- INLINE inRange #-}
 163     inRange ((l1,l2),(u1,u2)) (i1,i2) =
 164       inRange (l1,u1) i1 && inRange (l2,u2) i2
 165
 166     -- Default method for index
 167
 168 ----------------------------------------------------------------------
 169 instance  (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3)  where
 170     {-# SPECIALISE instance Ix (Int,Int,Int) #-}
 171
 172     range ((l1,l2,l3),(u1,u2,u3)) =
 173         [(i1,i2,i3) | i1 <- range (l1,u1),
 174                       i2 <- range (l2,u2),
 175                       i3 <- range (l3,u3)]
 176
 177     unsafeIndex ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
 178       unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
 179       unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
 180       unsafeIndex (l1,u1) i1))
 181
 182     inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
 183       inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
 184       inRange (l3,u3) i3
 185
 186     -- Default method for index
 187
 188 ----------------------------------------------------------------------
 189 instance  (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4)  where
 190     range ((l1,l2,l3,l4),(u1,u2,u3,u4)) =
 191       [(i1,i2,i3,i4) | i1 <- range (l1,u1),
 192                        i2 <- range (l2,u2),
 193                        i3 <- range (l3,u3),
 194                        i4 <- range (l4,u4)]
 195
 196     unsafeIndex ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
 197       unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
 198       unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
 199       unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
 200       unsafeIndex (l1,u1) i1)))
 201
 202     inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
 203       inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
 204       inRange (l3,u3) i3 && inRange (l4,u4) i4
 205
 206     -- Default method for index
 207
 208 instance  (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5)  where
 209     range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) =
 210       [(i1,i2,i3,i4,i5) | i1 <- range (l1,u1),
 211                           i2 <- range (l2,u2),
 212                           i3 <- range (l3,u3),
 213                           i4 <- range (l4,u4),
 214                           i5 <- range (l5,u5)]
 215
 216     unsafeIndex ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
 217       unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * (
 218       unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
 219       unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
 220       unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
 221       unsafeIndex (l1,u1) i1))))
 222
 223     inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
 224       inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
 225       inRange (l3,u3) i3 && inRange (l4,u4) i4 &&
 226       inRange (l5,u5) i5
 227
 228     -- Default method for index
 229 \end{code}
 230
 231
 232 %********************************************************
 233 %*                                                      *
 234 \subsection{Size of @Ix@ interval}
 235 %*                                                      *
 236 %********************************************************
 237
 238 The @rangeSize@ operator returns the number of elements
 239 in the range for an @Ix@ pair.
 240
 241 \begin{code}
 242 {-# SPECIALISE unsafeRangeSize :: (Int,Int) -> Int #-}
 243 {-# SPECIALISE unsafeRangeSize :: ((Int,Int),(Int,Int)) -> Int #-}
 244 unsafeRangeSize :: (Ix a) => (a,a) -> Int
 245 unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
 246
 247 {-# SPECIALISE rangeSize :: (Int,Int) -> Int #-}
 248 {-# SPECIALISE rangeSize :: ((Int,Int),(Int,Int)) -> Int #-}
 249 rangeSize :: (Ix a) => (a,a) -> Int
 250 rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1
 251                    | otherwise   = 0
 252
 253 -- Note that the following is NOT right
 254 --      rangeSize (l,h) | l <= h    = index b h + 1
 255 --                      | otherwise = 0
 256 --
 257 -- Because it might be the case that l<h, but the range
 258 -- is nevertheless empty.  Consider
 259 --      ((1,2),(2,1))
 260 -- Here l<h, but the second index ranges from 2..1 and
 261 -- hence is empty
 262 \end{code}
 263
 264
 265
 266 %*********************************************************
 267 %*                                                      *
 268 \subsection{The @Array@ types}
 269 %*                                                      *
 270 %*********************************************************
 271
 272 \begin{code}
 273 type IPr = (Int, Int)
 274
 275 data Ix ix => Array     ix elt = Array   ix ix (Array# elt)
 276 data Ix ix => STArray s ix elt = STArray ix ix (MutableArray# s elt)
 277
 278 -- Mutterings about dependent types... ignore!
 279 -- Array :: ix -> ix -> Array# elt -> Array
 280 -- Array :: forall { l::int, h::int, l<=h } Int(l) -> Int(h) -> Array#(h-l+1) -> Array(l,h)
 281 -- Array :: forall { l1,l2::int, h1,h2::int, l1<=h1+1,l2<=h2+1 }
 282 --                 (Int(l1),Int(l2)) -> (Int(h1),Int(h2)) -> Array#((h1-l1+1)*(h2-l2+1)) -> Array(l1,h1,l2,h2)
 283
 284
 285 data STRef s a = STRef (MutVar# s a)
 286
 287 instance Eq (STRef s a) where
 288         STRef v1# == STRef v2#
 289                 = sameMutVar# v1# v2#
 290
 291 -- just pointer equality on arrays:
 292 instance Eq (STArray s ix elt) where
 293         STArray _ _ arr1# == STArray _ _ arr2#
 294                 = sameMutableArray# arr1# arr2#
 295 \end{code}
 296
 297 %*********************************************************
 298 %*                                                      *
 299 \subsection{Operations on mutable variables}
 300 %*                                                      *
 301 %*********************************************************
 302
 303 \begin{code}
 304 newSTRef   :: a -> ST s (STRef s a)
 305 readSTRef  :: STRef s a -> ST s a
 306 writeSTRef :: STRef s a -> a -> ST s ()
 307
 308 newSTRef init = ST $ \ s# ->
 309     case (newMutVar# init s#)     of { (# s2#, var# #) ->
 310     (# s2#, STRef var# #) }
 311
 312 readSTRef (STRef var#) = ST $ \ s# -> readMutVar# var# s#
 313
 314 writeSTRef (STRef var#) val = ST $ \ s# ->
 315     case writeMutVar# var# val s# of { s2# ->
 316     (# s2#, () #) }
 317 \end{code}
 318
 319 %*********************************************************
 320 %*                                                      *
 321 \subsection{Operations on immutable arrays}
 322 %*                                                      *
 323 %*********************************************************
 324
 325 "array", "!" and "bounds" are basic; the rest can be defined in terms of them
 326
 327 \begin{code}
 328 bounds                :: (Ix a) => Array a b -> (a,a)
 329 {-# INLINE bounds #-}
 330 bounds (Array l u _)  = (l,u)
 331
 332 assocs                :: (Ix a) => Array a b -> [(a,b)]
 333 {-# INLINE assocs #-}   -- Want to fuse the list comprehension
 334 assocs a              =  [(i, a!i) | i <- indices a]
 335
 336 indices               :: (Ix a) => Array a b -> [a]
 337 {-# INLINE indices #-}
 338 indices               =  range . bounds
 339
 340 {-# SPECIALISE amap :: (b -> c) -> Array Int b -> Array Int c #-}
 341 amap                  :: (Ix a) => (b -> c) -> Array a b -> Array a c
 342 amap f a              =  array b [(i, f (a!i)) | i <- range b]
 343                          where b = bounds a
 344
 345 {-# SPECIALISE (!) :: Array Int b -> Int -> b #-}
 346 (!)                   :: (Ix a) => Array a b -> a -> b
 347 (Array l u arr#) ! i
 348   = let n# = case (index (l,u) i) of { I# x -> x } -- index fails if out of range
 349     in
 350     case (indexArray# arr# n#) of
 351       (# v #) -> v
 352
 353
 354 array                 :: (Ix a) => (a,a) -> [(a,b)] -> Array a b
 355 {-# INLINE array #-}
 356 array ixs ivs
 357   = case rangeSize ixs                          of { I# n ->
 358     runST ( ST $ \ s1 ->
 359         case newArray# n arrEleBottom s1        of { (# s2, marr #) ->
 360         foldr (fill ixs marr) (done ixs marr) ivs s2
 361     })}
 362
 363 fill :: Ix ix => (ix,ix)  -> MutableArray# s elt
 364               -> (ix,elt) -> STRep s a -> STRep s a
 365 {-# INLINE fill #-}
 366 fill ixs marr (i,v) next = \s1 -> case index ixs i      of { I# n ->
 367                                   case writeArray# marr n v s1  of { s2 ->
 368                                   next s2 }}
 369
 370 done :: Ix ix => (ix,ix) -> MutableArray# s elt
 371               -> STRep s (Array ix elt)
 372 {-# INLINE done #-}
 373 done (l,u) marr = \s1 ->
 374    case unsafeFreezeArray# marr s1 of { (# s2, arr #) ->
 375    (# s2, Array l u arr #) }
 376
 377 arrEleBottom :: a
 378 arrEleBottom = error "(Array.!): undefined array element"
 379
 380
 381 -----------------------------------------------------------------------
 382 -- These also go better with magic: (//), accum, accumArray
 383 -- *** NB *** We INLINE them all so that their foldr's get to the call site
 384
 385 (//)                  :: (Ix a) => Array a b -> [(a,b)] -> Array a b
 386 {-# INLINE (//) #-}
 387 old_array // ivs
 388   = runST (do
 389         -- copy the old array:
 390         arr <- thawSTArray old_array
 391         -- now write the new elements into the new array:
 392         fill_it_in arr ivs
 393         freezeSTArray arr
 394     )
 395
 396 fill_it_in :: Ix ix => STArray s ix elt -> [(ix, elt)] -> ST s ()
 397 {-# INLINE fill_it_in #-}
 398 fill_it_in arr lst = foldr (fill_one_in arr) (return ()) lst
 399          -- **** STRICT **** (but that's OK...)
 400
 401 fill_one_in arr (i, v) rst = writeSTArray arr i v >> rst
 402
 403 zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> STArray s ix elt -> [(ix,elt2)] -> ST s ()
 404 -- zap_with_f: reads an elem out first, then uses "f" on that and the new value
 405 {-# INLINE zap_with_f #-}
 406
 407 zap_with_f f arr lst
 408   = foldr (zap_one f arr) (return ()) lst
 409
 410 zap_one f arr (i, new_v) rst = do
 411         old_v <- readSTArray arr i
 412         writeSTArray arr i (f old_v new_v)
 413         rst
 414
 415 accum                 :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b
 416 {-# INLINE accum #-}
 417 accum f old_array ivs
 418   = runST (do
 419         -- copy the old array:
 420         arr <- thawSTArray old_array
 421         -- now zap the elements in question with "f":
 422         zap_with_f f arr ivs
 423         freezeSTArray arr
 424     )
 425
 426
 427 accumArray            :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b
 428 {-# INLINE accumArray #-}
 429 accumArray f zero ixs ivs
 430   = runST (do
 431         arr <- newSTArray ixs zero
 432         zap_with_f f arr ivs
 433         freezeSTArray arr
 434     )
 435 \end{code}
 436
 437
 438 %*********************************************************
 439 %*                                                      *
 440 \subsection{Array instances}
 441 %*                                                      *
 442 %*********************************************************
 443
 444
 445 \begin{code}
 446 instance Ix a => Functor (Array a) where
 447   fmap = amap
 448
 449 instance  (Ix a, Eq b)  => Eq (Array a b)  where
 450     a == a'             =  assocs a == assocs a'
 451     a /= a'             =  assocs a /= assocs a'
 452
 453 instance  (Ix a, Ord b) => Ord (Array a b)  where
 454     compare a b = compare (assocs a) (assocs b)
 455
 456 instance  (Ix a, Show a, Show b) => Show (Array a b)  where
 457     showsPrec p a = showParen (p > 9) (
 458                     showString "array " .
 459                     shows (bounds a) . showChar ' ' .
 460                     shows (assocs a)                  )
 461     showList = showList__ (showsPrec 0)
 462
 463 {-
 464 instance  (Ix a, Read a, Read b) => Read (Array a b)  where
 465     readsPrec p = readParen (p > 9)
 466            (\r -> [(array b as, u) | ("array",s) <- lex r,
 467                                      (b,t)       <- reads s,
 468                                      (as,u)      <- reads t   ])
 469     readList = readList__ (readsPrec 0)
 470 -}
 471 \end{code}
 472
 473
 474 %*********************************************************
 475 %*                                                      *
 476 \subsection{Operations on mutable arrays}
 477 %*                                                      *
 478 %*********************************************************
 479
 480 Idle ADR question: What's the tradeoff here between flattening these
 481 datatypes into @STArray ix ix (MutableArray# s elt)@ and using
 482 it as is?  As I see it, the former uses slightly less heap and
 483 provides faster access to the individual parts of the bounds while the
 484 code used has the benefit of providing a ready-made @(lo, hi)@ pair as
 485 required by many array-related functions.  Which wins? Is the
 486 difference significant (probably not).
 487
 488 Idle AJG answer: When I looked at the outputted code (though it was 2
 489 years ago) it seems like you often needed the tuple, and we build
 490 it frequently. Now we've got the overloading specialiser things
 491 might be different, though.
 492
 493 \begin{code}
 494 newSTArray :: Ix ix => (ix,ix) -> elt -> ST s (STArray s ix elt)
 495
 496 {-# SPECIALIZE newSTArray :: IPr       -> elt -> ST s (STArray s Int elt),
 497                              (IPr,IPr) -> elt -> ST s (STArray s IPr elt)
 498   #-}
 499 newSTArray (l,u) init = ST $ \ s# ->
 500     case rangeSize (l,u)          of { I# n# ->
 501     case (newArray# n# init s#)   of { (# s2#, arr# #) ->
 502     (# s2#, STArray l u arr# #) }}
 503
 504
 505
 506 boundsSTArray     :: Ix ix => STArray s ix elt -> (ix, ix)
 507 {-# SPECIALIZE boundsSTArray :: STArray s Int elt -> IPr #-}
 508 boundsSTArray     (STArray     l u _) = (l,u)
 509
 510 readSTArray     :: Ix ix => STArray s ix elt -> ix -> ST s elt
 511 {-# SPECIALIZE readSTArray :: STArray s Int elt -> Int -> ST s elt,
 512                               STArray s IPr elt -> IPr -> ST s elt
 513   #-}
 514
 515 readSTArray (STArray l u arr#) n = ST $ \ s# ->
 516     case (index (l,u) n)                of { I# n# ->
 517     case readArray# arr# n# s#          of { (# s2#, r #) ->
 518     (# s2#, r #) }}
 519
 520 writeSTArray     :: Ix ix => STArray s ix elt -> ix -> elt -> ST s ()
 521 {-# SPECIALIZE writeSTArray :: STArray s Int elt -> Int -> elt -> ST s (),
 522                                STArray s IPr elt -> IPr -> elt -> ST s ()
 523   #-}
 524
 525 writeSTArray (STArray l u arr#) n ele = ST $ \ s# ->
 526     case index (l,u) n                      of { I# n# ->
 527     case writeArray# arr# n# ele s#         of { s2# ->
 528     (# s2#, () #) }}
 529 \end{code}
 530
 531
 532 %*********************************************************
 533 %*                                                      *
 534 \subsection{Moving between mutable and immutable}
 535 %*                                                      *
 536 %*********************************************************
 537
 538 \begin{code}
 539 freezeSTArray     :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
 540 {-# SPECIALISE freezeSTArray :: STArray s Int elt -> ST s (Array Int elt),
 541                               STArray s IPr elt -> ST s (Array IPr elt)
 542   #-}
 543
 544 freezeSTArray (STArray l u arr#) = ST $ \ s# ->
 545     case rangeSize (l,u)     of { I# n# ->
 546     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 547     (# s2#, Array l u frozen# #) }}
 548
 549 freeze  :: MutableArray# s ele  -- the thing
 550         -> Int#                 -- size of thing to be frozen
 551         -> State# s                     -- the Universe and everything
 552         -> (# State# s, Array# ele #)
 553 freeze m_arr# n# s#
 554  = case newArray# n# init s#             of { (# s2#, newarr1# #) ->
 555    case copy 0# n# m_arr# newarr1# s2#   of { (# s3#, newarr2# #) ->
 556    unsafeFreezeArray# newarr2# s3#
 557    }}
 558  where
 559         init = error "freezeArray: element not copied"
 560
 561         copy :: Int# -> Int#
 562              -> MutableArray# s ele
 563              -> MutableArray# s ele
 564              -> State# s
 565              -> (# State# s, MutableArray# s ele #)
 566
 567         copy cur# end# from# to# st#
 568           | cur# ==# end#
 569             = (# st#, to# #)
 570           | otherwise
 571             = case readArray#  from# cur#     st#  of { (# s1#, ele #) ->
 572               case writeArray# to#   cur# ele s1# of { s2# ->
 573               copy (cur# +# 1#) end# from# to# s2#
 574               }}
 575
 576 unsafeFreezeSTArray     :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
 577 unsafeFreezeSTArray (STArray l u arr#) = ST $ \ s# ->
 578     case unsafeFreezeArray# arr# s# of { (# s2#, frozen# #) ->
 579     (# s2#, Array l u frozen# #) }
 580
 581 --This takes a immutable array, and copies it into a mutable array, in a
 582 --hurry.
 583
 584 thawSTArray :: Ix ix => Array ix elt -> ST s (STArray s ix elt)
 585 {-# SPECIALISE thawSTArray :: Array Int elt -> ST s (STArray s Int elt),
 586                               Array IPr elt -> ST s (STArray s IPr elt)
 587   #-}
 588
 589 thawSTArray (Array l u arr#) = ST $ \ s# ->
 590     case rangeSize (l,u) of { I# n# ->
 591     case thaw arr# n# s# of { (# s2#, thawed# #) ->
 592     (# s2#, STArray l u thawed# #)}}
 593
 594 thaw  :: Array# ele             -- the thing
 595       -> Int#                   -- size of thing to be thawed
 596       -> State# s               -- the Universe and everything
 597       -> (# State# s, MutableArray# s ele #)
 598
 599 thaw arr1# n# s#
 600   = case newArray# n# init s#         of { (# s2#, newarr1# #) ->
 601     copy 0# n# arr1# newarr1# s2# }
 602   where
 603         init = error "thawSTArray: element not copied"
 604
 605         copy :: Int# -> Int#
 606              -> Array# ele
 607              -> MutableArray# s ele
 608              -> State# s
 609              -> (# State# s, MutableArray# s ele #)
 610
 611         copy cur# end# from# to# st#
 612           | cur# ==# end#
 613             = (# st#, to# #)
 614           | otherwise
 615             = case indexArray#  from# cur#        of { (# ele #) ->
 616               case writeArray# to#   cur# ele st# of { s1# ->
 617               copy (cur# +# 1#) end# from# to# s1#
 618               }}
 619
 620 -- this is a quicker version of the above, just flipping the type
 621 -- (& representation) of an immutable array. And placing a
 622 -- proof obligation on the programmer.
 623 unsafeThawSTArray :: Ix ix => Array ix elt -> ST s (STArray s ix elt)
 624 unsafeThawSTArray (Array l u arr#) = ST $ \ s# ->
 625    case unsafeThawArray# arr# s# of
 626       (# s2#, marr# #) -> (# s2#, STArray l u marr# #)
 627 \end{code}