ghc/lib/std/PrelArr.lhs

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