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 For byte-arrays see @PrelByteArr@.
  10
  11 \begin{code}
  12 {-# OPTIONS -fno-implicit-prelude #-}
  13
  14 module PrelArr where
  15
  16 import {-# SOURCE #-} PrelErr ( error )
  17 import PrelList (foldl)
  18 import PrelEnum
  19 import PrelNum
  20 import PrelST
  21 import PrelBase
  22 import PrelAddr
  23 import PrelGHC
  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
 279 data STRef s a = STRef (MutVar# s a)
 280
 281 instance Eq (STRef s a) where
 282         STRef v1# == STRef v2#
 283                 = sameMutVar# v1# v2#
 284
 285 -- just pointer equality on arrays:
 286 instance Eq (STArray s ix elt) where
 287         STArray _ _ arr1# == STArray _ _ arr2#
 288                 = sameMutableArray# arr1# arr2#
 289 \end{code}
 290
 291 %*********************************************************
 292 %*                                                      *
 293 \subsection{Operations on mutable variables}
 294 %*                                                      *
 295 %*********************************************************
 296
 297 \begin{code}
 298 newSTRef   :: a -> ST s (STRef s a)
 299 readSTRef  :: STRef s a -> ST s a
 300 writeSTRef :: STRef s a -> a -> ST s ()
 301
 302 newSTRef init = ST $ \ s# ->
 303     case (newMutVar# init s#)     of { (# s2#, var# #) ->
 304     (# s2#, STRef var# #) }
 305
 306 readSTRef (STRef var#) = ST $ \ s# -> readMutVar# var# s#
 307
 308 writeSTRef (STRef var#) val = ST $ \ s# ->
 309     case writeMutVar# var# val s# of { s2# ->
 310     (# s2#, () #) }
 311 \end{code}
 312
 313 %*********************************************************
 314 %*                                                      *
 315 \subsection{Operations on immutable arrays}
 316 %*                                                      *
 317 %*********************************************************
 318
 319 "array", "!" and "bounds" are basic; the rest can be defined in terms of them
 320
 321 \begin{code}
 322 bounds                :: (Ix a) => Array a b -> (a,a)
 323 {-# INLINE bounds #-}
 324 bounds (Array l u _)  = (l,u)
 325
 326 assocs                :: (Ix a) => Array a b -> [(a,b)]
 327 {-# INLINE assocs #-}   -- Want to fuse the list comprehension
 328 assocs a              =  [(i, a!i) | i <- indices a]
 329
 330 indices               :: (Ix a) => Array a b -> [a]
 331 {-# INLINE indices #-}
 332 indices               =  range . bounds
 333
 334 {-# SPECIALISE amap :: (b -> c) -> Array Int b -> Array Int c #-}
 335 amap                  :: (Ix a) => (b -> c) -> Array a b -> Array a c
 336 amap f a              =  array b [(i, f (a!i)) | i <- range b]
 337                          where b = bounds a
 338
 339 {-# SPECIALISE (!) :: Array Int b -> Int -> b #-}
 340 (!)                   :: (Ix a) => Array a b -> a -> b
 341 (Array l u arr#) ! i
 342   = let n# = case (index (l,u) i) of { I# x -> x } -- index fails if out of range
 343     in
 344     case (indexArray# arr# n#) of
 345       (# v #) -> v
 346
 347
 348 array                 :: (Ix a) => (a,a) -> [(a,b)] -> Array a b
 349 {-# INLINE array #-}
 350 array ixs ivs
 351   = case rangeSize ixs                          of { I# n ->
 352     runST ( ST $ \ s1 ->
 353         case newArray# n arrEleBottom s1        of { (# s2, marr #) ->
 354         foldr (fill ixs marr) (done ixs marr) ivs s2
 355     })}
 356
 357 fill :: Ix ix => (ix,ix)  -> MutableArray# s elt
 358               -> (ix,elt) -> STRep s a -> STRep s a
 359 {-# INLINE fill #-}
 360 fill ixs marr (i,v) next = \s1 -> case index ixs i      of { I# n ->
 361                                   case writeArray# marr n v s1  of { s2 ->
 362                                   next s2 }}
 363
 364 done :: Ix ix => (ix,ix) -> MutableArray# s elt
 365               -> STRep s (Array ix elt)
 366 {-# INLINE done #-}
 367 done (l,u) marr = \s1 ->
 368    case unsafeFreezeArray# marr s1 of { (# s2, arr #) ->
 369    (# s2, Array l u arr #) }
 370
 371 arrEleBottom :: a
 372 arrEleBottom = error "(Array.!): undefined array element"
 373
 374
 375 -----------------------------------------------------------------------
 376 -- These also go better with magic: (//), accum, accumArray
 377 -- *** NB *** We INLINE them all so that their foldr's get to the call site
 378
 379 (//)                  :: (Ix a) => Array a b -> [(a,b)] -> Array a b
 380 {-# INLINE (//) #-}
 381 old_array // ivs
 382   = runST (do
 383         -- copy the old array:
 384         arr <- thawSTArray old_array
 385         -- now write the new elements into the new array:
 386         fill_it_in arr ivs
 387         freezeSTArray arr
 388     )
 389
 390 fill_it_in :: Ix ix => STArray s ix elt -> [(ix, elt)] -> ST s ()
 391 {-# INLINE fill_it_in #-}
 392 fill_it_in arr lst = foldr (fill_one_in arr) (return ()) lst
 393          -- **** STRICT **** (but that's OK...)
 394
 395 fill_one_in arr (i, v) rst = writeSTArray arr i v >> rst
 396
 397 zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> STArray s ix elt -> [(ix,elt2)] -> ST s ()
 398 -- zap_with_f: reads an elem out first, then uses "f" on that and the new value
 399 {-# INLINE zap_with_f #-}
 400
 401 zap_with_f f arr lst
 402   = foldr (zap_one f arr) (return ()) lst
 403
 404 zap_one f arr (i, new_v) rst = do
 405         old_v <- readSTArray arr i
 406         writeSTArray arr i (f old_v new_v)
 407         rst
 408
 409 accum                 :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b
 410 {-# INLINE accum #-}
 411 accum f old_array ivs
 412   = runST (do
 413         -- copy the old array:
 414         arr <- thawSTArray old_array
 415         -- now zap the elements in question with "f":
 416         zap_with_f f arr ivs
 417         freezeSTArray arr
 418     )
 419
 420
 421 accumArray            :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b
 422 {-# INLINE accumArray #-}
 423 accumArray f zero ixs ivs
 424   = runST (do
 425         arr <- newSTArray ixs zero
 426         zap_with_f f arr ivs
 427         freezeSTArray arr
 428     )
 429 \end{code}
 430
 431
 432 %*********************************************************
 433 %*                                                      *
 434 \subsection{Array instances}
 435 %*                                                      *
 436 %*********************************************************
 437
 438
 439 \begin{code}
 440 instance Ix a => Functor (Array a) where
 441   fmap = amap
 442
 443 instance  (Ix a, Eq b)  => Eq (Array a b)  where
 444     a == a'             =  assocs a == assocs a'
 445     a /= a'             =  assocs a /= assocs a'
 446
 447 instance  (Ix a, Ord b) => Ord (Array a b)  where
 448     compare a b = compare (assocs a) (assocs b)
 449
 450 instance  (Ix a, Show a, Show b) => Show (Array a b)  where
 451     showsPrec p a = showParen (p > 9) (
 452                     showString "array " .
 453                     shows (bounds a) . showChar ' ' .
 454                     shows (assocs a)                  )
 455     showList = showList__ (showsPrec 0)
 456
 457 {-
 458 instance  (Ix a, Read a, Read b) => Read (Array a b)  where
 459     readsPrec p = readParen (p > 9)
 460            (\r -> [(array b as, u) | ("array",s) <- lex r,
 461                                      (b,t)       <- reads s,
 462                                      (as,u)      <- reads t   ])
 463     readList = readList__ (readsPrec 0)
 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   where
 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   where
 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}