ghc/lib/std/PrelArr.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: PrelArr.lhs,v 1.26 2001/03/25 09:57:24 qrczak 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         foldr (fill_one_in arr) (unsafeFreezeSTArray arr) ivs
 393     )
 394
 395 {-# INLINE fill_one_in #-}
 396 fill_one_in :: Ix ix => STArray s ix e -> (ix, e) -> ST s a -> ST s a
 397 fill_one_in arr (i, v) next = writeSTArray arr i v >> next
 398
 399 zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> STArray s ix elt -> [(ix,elt2)] -> ST s ()
 400 -- zap_with_f: reads an elem out first, then uses "f" on that and the new value
 401 {-# INLINE zap_with_f #-}
 402
 403 zap_with_f f arr lst
 404   = foldr (zap_one f arr) (return ()) lst
 405
 406 zap_one f arr (i, new_v) rst = do
 407         old_v <- readSTArray arr i
 408         writeSTArray arr i (f old_v new_v)
 409         rst
 410
 411 accum                 :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b
 412 {-# INLINE accum #-}
 413 accum f old_array ivs
 414   = runST (do
 415         -- copy the old array:
 416         arr <- thawSTArray old_array
 417         -- now zap the elements in question with "f":
 418         zap_with_f f arr ivs
 419         unsafeFreezeSTArray arr
 420     )
 421
 422
 423 accumArray            :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b
 424 {-# INLINE accumArray #-}
 425 accumArray f zero ixs ivs
 426   = runST (do
 427         arr <- newSTArray ixs zero
 428         zap_with_f f arr ivs
 429         unsafeFreezeSTArray arr
 430     )
 431 \end{code}
 432
 433
 434 %*********************************************************
 435 %*                                                      *
 436 \subsection{Array instances}
 437 %*                                                      *
 438 %*********************************************************
 439
 440
 441 \begin{code}
 442 instance Ix a => Functor (Array a) where
 443   fmap = amap
 444
 445 instance  (Ix a, Eq b)  => Eq (Array a b)  where
 446     a == a'             =  assocs a == assocs a'
 447     a /= a'             =  assocs a /= assocs a'
 448
 449 instance  (Ix a, Ord b) => Ord (Array a b)  where
 450     compare a b = compare (assocs a) (assocs b)
 451
 452 instance  (Ix a, Show a, Show b) => Show (Array a b)  where
 453     showsPrec p a = showParen (p > 9) (
 454                     showString "array " .
 455                     shows (bounds a) . showChar ' ' .
 456                     shows (assocs a)                  )
 457
 458 {-
 459 instance  (Ix a, Read a, Read b) => Read (Array a b)  where
 460     readsPrec p = readParen (p > 9)
 461            (\r -> [(array b as, u) | ("array",s) <- lex r,
 462                                      (b,t)       <- reads s,
 463                                      (as,u)      <- reads t   ])
 464 -}
 465 \end{code}
 466
 467
 468 %*********************************************************
 469 %*                                                      *
 470 \subsection{Operations on mutable arrays}
 471 %*                                                      *
 472 %*********************************************************
 473
 474 Idle ADR question: What's the tradeoff here between flattening these
 475 datatypes into @STArray ix ix (MutableArray# s elt)@ and using
 476 it as is?  As I see it, the former uses slightly less heap and
 477 provides faster access to the individual parts of the bounds while the
 478 code used has the benefit of providing a ready-made @(lo, hi)@ pair as
 479 required by many array-related functions.  Which wins? Is the
 480 difference significant (probably not).
 481
 482 Idle AJG answer: When I looked at the outputted code (though it was 2
 483 years ago) it seems like you often needed the tuple, and we build
 484 it frequently. Now we've got the overloading specialiser things
 485 might be different, though.
 486
 487 \begin{code}
 488 newSTArray :: Ix ix => (ix,ix) -> elt -> ST s (STArray s ix elt)
 489
 490 {-# SPECIALIZE newSTArray :: IPr       -> elt -> ST s (STArray s Int elt),
 491                              (IPr,IPr) -> elt -> ST s (STArray s IPr elt)
 492   #-}
 493 newSTArray (l,u) init = ST $ \ s# ->
 494     case rangeSize (l,u)          of { I# n# ->
 495     case (newArray# n# init s#)   of { (# s2#, arr# #) ->
 496     (# s2#, STArray l u arr# #) }}
 497
 498
 499
 500 boundsSTArray     :: Ix ix => STArray s ix elt -> (ix, ix)
 501 {-# SPECIALIZE boundsSTArray :: STArray s Int elt -> IPr #-}
 502 boundsSTArray     (STArray     l u _) = (l,u)
 503
 504 readSTArray     :: Ix ix => STArray s ix elt -> ix -> ST s elt
 505 {-# SPECIALIZE readSTArray :: STArray s Int elt -> Int -> ST s elt,
 506                               STArray s IPr elt -> IPr -> ST s elt
 507   #-}
 508
 509 readSTArray (STArray l u arr#) n = ST $ \ s# ->
 510     case (index (l,u) n)                of { I# n# ->
 511     case readArray# arr# n# s#          of { (# s2#, r #) ->
 512     (# s2#, r #) }}
 513
 514 writeSTArray     :: Ix ix => STArray s ix elt -> ix -> elt -> ST s ()
 515 {-# SPECIALIZE writeSTArray :: STArray s Int elt -> Int -> elt -> ST s (),
 516                                STArray s IPr elt -> IPr -> elt -> ST s ()
 517   #-}
 518
 519 writeSTArray (STArray l u arr#) n ele = ST $ \ s# ->
 520     case index (l,u) n                      of { I# n# ->
 521     case writeArray# arr# n# ele s#         of { s2# ->
 522     (# s2#, () #) }}
 523 \end{code}
 524
 525
 526 %*********************************************************
 527 %*                                                      *
 528 \subsection{Moving between mutable and immutable}
 529 %*                                                      *
 530 %*********************************************************
 531
 532 \begin{code}
 533 freezeSTArray     :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
 534 {-# SPECIALISE freezeSTArray :: STArray s Int elt -> ST s (Array Int elt),
 535                               STArray s IPr elt -> ST s (Array IPr elt)
 536   #-}
 537
 538 freezeSTArray (STArray l u arr#) = ST $ \ s# ->
 539     case rangeSize (l,u)     of { I# n# ->
 540     case freeze arr# n# s# of { (# s2#, frozen# #) ->
 541     (# s2#, Array l u frozen# #) }}
 542
 543 freeze  :: MutableArray# s ele  -- the thing
 544         -> Int#                 -- size of thing to be frozen
 545         -> State# s                     -- the Universe and everything
 546         -> (# State# s, Array# ele #)
 547 freeze m_arr# n# s#
 548  = case newArray# n# init s#             of { (# s2#, newarr1# #) ->
 549    case copy 0# n# m_arr# newarr1# s2#   of { (# s3#, newarr2# #) ->
 550    unsafeFreezeArray# newarr2# s3#
 551    }}
 552  where
 553         init = error "freezeArray: element not copied"
 554
 555         copy :: Int# -> Int#
 556              -> MutableArray# s ele
 557              -> MutableArray# s ele
 558              -> State# s
 559              -> (# State# s, MutableArray# s ele #)
 560
 561         copy cur# end# from# to# st#
 562           | cur# ==# end#
 563             = (# st#, to# #)
 564           | otherwise
 565             = case readArray#  from# cur#     st#  of { (# s1#, ele #) ->
 566               case writeArray# to#   cur# ele s1# of { s2# ->
 567               copy (cur# +# 1#) end# from# to# s2#
 568               }}
 569
 570 unsafeFreezeSTArray     :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
 571 unsafeFreezeSTArray (STArray l u arr#) = ST $ \ s# ->
 572     case unsafeFreezeArray# arr# s# of { (# s2#, frozen# #) ->
 573     (# s2#, Array l u frozen# #) }
 574
 575 --This takes a immutable array, and copies it into a mutable array, in a
 576 --hurry.
 577
 578 thawSTArray :: Ix ix => Array ix elt -> ST s (STArray s ix elt)
 579 {-# SPECIALISE thawSTArray :: Array Int elt -> ST s (STArray s Int elt),
 580                               Array IPr elt -> ST s (STArray s IPr elt)
 581   #-}
 582
 583 thawSTArray (Array l u arr#) = ST $ \ s# ->
 584     case rangeSize (l,u) of { I# n# ->
 585     case thaw arr# n# s# of { (# s2#, thawed# #) ->
 586     (# s2#, STArray l u thawed# #)}}
 587
 588 thaw  :: Array# ele             -- the thing
 589       -> Int#                   -- size of thing to be thawed
 590       -> State# s               -- the Universe and everything
 591       -> (# State# s, MutableArray# s ele #)
 592
 593 thaw arr1# n# s#
 594   = case newArray# n# init s#         of { (# s2#, newarr1# #) ->
 595     copy 0# n# arr1# newarr1# s2# }
 596   where
 597         init = error "thawSTArray: element not copied"
 598
 599         copy :: Int# -> Int#
 600              -> Array# ele
 601              -> MutableArray# s ele
 602              -> State# s
 603              -> (# State# s, MutableArray# s ele #)
 604
 605         copy cur# end# from# to# st#
 606           | cur# ==# end#
 607             = (# st#, to# #)
 608           | otherwise
 609             = case indexArray#  from# cur#        of { (# ele #) ->
 610               case writeArray# to#   cur# ele st# of { s1# ->
 611               copy (cur# +# 1#) end# from# to# s1#
 612               }}
 613
 614 -- this is a quicker version of the above, just flipping the type
 615 -- (& representation) of an immutable array. And placing a
 616 -- proof obligation on the programmer.
 617 unsafeThawSTArray :: Ix ix => Array ix elt -> ST s (STArray s ix elt)
 618 unsafeThawSTArray (Array l u arr#) = ST $ \ s# ->
 619    case unsafeThawArray# arr# s# of
 620       (# s2#, marr# #) -> (# s2#, STArray l u marr# #)
 621 \end{code}