+% -----------------------------------------------------------------------------
+% $Id: PrelArr.lhs,v 1.28 2001/05/01 09:16:56 qrczak Exp $
%
-% (c) The AQUA Project, Glasgow University, 1994-1996
+% (c) The University of Glasgow, 1994-2000
%
+
\section[PrelArr]{Module @PrelArr@}
Array implementation, @PrelArr@ exports the basic array
types and operations.
+For byte-arrays see @PrelByteArr@.
+
\begin{code}
{-# OPTIONS -fno-implicit-prelude #-}
module PrelArr where
import {-# SOURCE #-} PrelErr ( error )
-import Ix
-import PrelList (foldl)
+import PrelEnum
+import PrelNum
import PrelST
import PrelBase
-import PrelCCall
-import PrelAddr
-import PrelGHC
+import PrelList
+import PrelShow
infixl 9 !, //
-\end{code}
-
-\begin{code}
-{-# SPECIALISE array :: (Int,Int) -> [(Int,b)] -> Array Int b #-}
-array :: (Ix a) => (a,a) -> [(a,b)] -> Array a b
-
-{-# SPECIALISE (!) :: Array Int b -> Int -> b #-}
-(!) :: (Ix a) => Array a b -> a -> b
-{-# SPECIALISE bounds :: Array Int b -> (Int,Int) #-}
-bounds :: (Ix a) => Array a b -> (a,a)
+default ()
+\end{code}
-{-# SPECIALISE (//) :: Array Int b -> [(Int,b)] -> Array Int b #-}
-(//) :: (Ix a) => Array a b -> [(a,b)] -> Array a b
-{-# SPECIALISE accum :: (b -> c -> b) -> Array Int b -> [(Int,c)] -> Array Int b #-}
-accum :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b
+%*********************************************************
+%* *
+\subsection{The @Ix@ class}
+%* *
+%*********************************************************
-{-# SPECIALISE accumArray :: (b -> c -> b) -> b -> (Int,Int) -> [(Int,c)] -> Array Int b #-}
-accumArray :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b
+\begin{code}
+class (Ord a) => Ix a where
+ range :: (a,a) -> [a]
+ index, unsafeIndex :: (a,a) -> a -> Int
+ inRange :: (a,a) -> a -> Bool
+
+ -- Must specify one of index, unsafeIndex
+ index b i | inRange b i = unsafeIndex b i
+ | otherwise = error "Error in array index"
+ unsafeIndex b i = index b i
\end{code}
%*********************************************************
%* *
-\subsection{The @Array@ types}
+\subsection{Instances of @Ix@}
%* *
%*********************************************************
\begin{code}
-type IPr = (Int, Int)
+-- abstract these errors from the relevant index functions so that
+-- the guts of the function will be small enough to inline.
+
+{-# NOINLINE indexError #-}
+indexError :: Show a => (a,a) -> a -> String -> b
+indexError rng i tp
+ = error (showString "Ix{" . showString tp . showString "}.index: Index " .
+ showParen True (showsPrec 0 i) .
+ showString " out of range " $
+ showParen True (showsPrec 0 rng) "")
+
+----------------------------------------------------------------------
+instance Ix Char where
+ {-# INLINE range #-}
+ range (m,n) = [m..n]
+
+ {-# INLINE unsafeIndex #-}
+ unsafeIndex (m,_n) i = fromEnum i - fromEnum m
+
+ index b i | inRange b i = unsafeIndex b i
+ | otherwise = indexError b i "Char"
+
+ inRange (m,n) i = m <= i && i <= n
+
+----------------------------------------------------------------------
+instance Ix Int where
+ {-# INLINE range #-}
+ -- The INLINE stops the build in the RHS from getting inlined,
+ -- so that callers can fuse with the result of range
+ range (m,n) = [m..n]
+
+ {-# INLINE unsafeIndex #-}
+ unsafeIndex (m,_n) i = i - m
+
+ index b i | inRange b i = unsafeIndex b i
+ | otherwise = indexError b i "Int"
+
+ {-# INLINE inRange #-}
+ inRange (I# m,I# n) (I# i) = m <=# i && i <=# n
+
+----------------------------------------------------------------------
+instance Ix Integer where
+ {-# INLINE range #-}
+ range (m,n) = [m..n]
+
+ {-# INLINE unsafeIndex #-}
+ unsafeIndex (m,_n) i = fromInteger (i - m)
+
+ index b i | inRange b i = unsafeIndex b i
+ | otherwise = indexError b i "Integer"
+
+ inRange (m,n) i = m <= i && i <= n
+
+
+----------------------------------------------------------------------
+instance Ix Bool where -- as derived
+ {-# INLINE range #-}
+ range (m,n) = [m..n]
+
+ {-# INLINE unsafeIndex #-}
+ unsafeIndex (l,_) i = fromEnum i - fromEnum l
+
+ index b i | inRange b i = unsafeIndex b i
+ | otherwise = indexError b i "Bool"
+
+ inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
+
+----------------------------------------------------------------------
+instance Ix Ordering where -- as derived
+ {-# INLINE range #-}
+ range (m,n) = [m..n]
+
+ {-# INLINE unsafeIndex #-}
+ unsafeIndex (l,_) i = fromEnum i - fromEnum l
+
+ index b i | inRange b i = unsafeIndex b i
+ | otherwise = indexError b i "Ordering"
+
+ inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
+
+----------------------------------------------------------------------
+instance Ix () where
+ {-# INLINE range #-}
+ range ((), ()) = [()]
+ {-# INLINE unsafeIndex #-}
+ unsafeIndex ((), ()) () = 0
+ {-# INLINE inRange #-}
+ inRange ((), ()) () = True
+ {-# INLINE index #-}
+ index b i = unsafeIndex b i
+
+
+----------------------------------------------------------------------
+instance (Ix a, Ix b) => Ix (a, b) where -- as derived
+ {-# SPECIALISE instance Ix (Int,Int) #-}
+
+ {- INLINE range #-}
+ range ((l1,l2),(u1,u2)) =
+ [ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ]
+
+ {- INLINE unsafeIndex #-}
+ unsafeIndex ((l1,l2),(u1,u2)) (i1,i2) =
+ unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2
+
+ {- INLINE inRange #-}
+ inRange ((l1,l2),(u1,u2)) (i1,i2) =
+ inRange (l1,u1) i1 && inRange (l2,u2) i2
+
+ -- Default method for index
+
+----------------------------------------------------------------------
+instance (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3) where
+ {-# SPECIALISE instance Ix (Int,Int,Int) #-}
+
+ range ((l1,l2,l3),(u1,u2,u3)) =
+ [(i1,i2,i3) | i1 <- range (l1,u1),
+ i2 <- range (l2,u2),
+ i3 <- range (l3,u3)]
-data Ix ix => Array ix elt = Array (ix,ix) (Array# elt)
-data Ix ix => ByteArray ix = ByteArray (ix,ix) ByteArray#
-data Ix ix => MutableArray s ix elt = MutableArray (ix,ix) (MutableArray# s elt)
-data Ix ix => MutableByteArray s ix = MutableByteArray (ix,ix) (MutableByteArray# s)
+ unsafeIndex ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
+ unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
+ unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
+ unsafeIndex (l1,u1) i1))
-instance CCallable (MutableByteArray s ix)
-instance CCallable (MutableByteArray# s)
+ inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
+ inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
+ inRange (l3,u3) i3
-instance CCallable (ByteArray ix)
-instance CCallable ByteArray#
+ -- Default method for index
-data MutableVar s a = MutableVar (MutVar# s a)
+----------------------------------------------------------------------
+instance (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4) where
+ range ((l1,l2,l3,l4),(u1,u2,u3,u4)) =
+ [(i1,i2,i3,i4) | i1 <- range (l1,u1),
+ i2 <- range (l2,u2),
+ i3 <- range (l3,u3),
+ i4 <- range (l4,u4)]
-instance Eq (MutableVar s a) where
- MutableVar v1# == MutableVar v2#
- = sameMutVar# v1# v2#
+ unsafeIndex ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
+ unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
+ unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
+ unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
+ unsafeIndex (l1,u1) i1)))
--- just pointer equality on arrays:
-instance Eq (MutableArray s ix elt) where
- MutableArray _ arr1# == MutableArray _ arr2#
- = sameMutableArray# arr1# arr2#
+ inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
+ inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
+ inRange (l3,u3) i3 && inRange (l4,u4) i4
-instance Eq (MutableByteArray s ix) where
- MutableByteArray _ arr1# == MutableByteArray _ arr2#
- = sameMutableByteArray# arr1# arr2#
+ -- Default method for index
+
+instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5) where
+ range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) =
+ [(i1,i2,i3,i4,i5) | i1 <- range (l1,u1),
+ i2 <- range (l2,u2),
+ i3 <- range (l3,u3),
+ i4 <- range (l4,u4),
+ i5 <- range (l5,u5)]
+
+ unsafeIndex ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
+ unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * (
+ unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
+ unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
+ unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
+ unsafeIndex (l1,u1) i1))))
+
+ inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
+ inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
+ inRange (l3,u3) i3 && inRange (l4,u4) i4 &&
+ inRange (l5,u5) i5
+
+ -- Default method for index
\end{code}
+
+%********************************************************
+%* *
+\subsection{Size of @Ix@ interval}
+%* *
+%********************************************************
+
+The @rangeSize@ operator returns the number of elements
+in the range for an @Ix@ pair.
+
+\begin{code}
+{-# SPECIALISE unsafeRangeSize :: (Int,Int) -> Int #-}
+{-# SPECIALISE unsafeRangeSize :: ((Int,Int),(Int,Int)) -> Int #-}
+unsafeRangeSize :: (Ix a) => (a,a) -> Int
+unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
+
+{-# SPECIALISE rangeSize :: (Int,Int) -> Int #-}
+{-# SPECIALISE rangeSize :: ((Int,Int),(Int,Int)) -> Int #-}
+rangeSize :: (Ix a) => (a,a) -> Int
+rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1
+ | otherwise = 0
+
+-- Note that the following is NOT right
+-- rangeSize (l,h) | l <= h = index b h + 1
+-- | otherwise = 0
+--
+-- Because it might be the case that l<h, but the range
+-- is nevertheless empty. Consider
+-- ((1,2),(2,1))
+-- Here l<h, but the second index ranges from 2..1 and
+-- hence is empty
+\end{code}
+
+
%*********************************************************
%* *
-\subsection{Operations on mutable variables}
+\subsection{Mutable references}
%* *
%*********************************************************
\begin{code}
-newVar :: a -> ST s (MutableVar s a)
-readVar :: MutableVar s a -> ST s a
-writeVar :: MutableVar s a -> a -> ST s ()
+data STRef s a = STRef (MutVar# s a)
-newVar init = ST $ \ s# ->
- case (newMutVar# init s#) of { (# s2#, var# #) ->
- (# s2#, MutableVar var# #) }
+newSTRef :: a -> ST s (STRef s a)
+newSTRef init = ST $ \s1# ->
+ case newMutVar# init s1# of { (# s2#, var# #) ->
+ (# s2#, STRef var# #) }
-readVar (MutableVar var#) = ST $ \ s# -> readMutVar# var# s#
+readSTRef :: STRef s a -> ST s a
+readSTRef (STRef var#) = ST $ \s1# -> readMutVar# var# s1#
-writeVar (MutableVar var#) val = ST $ \ s# ->
- case writeMutVar# var# val s# of { s2# ->
+writeSTRef :: STRef s a -> a -> ST s ()
+writeSTRef (STRef var#) val = ST $ \s1# ->
+ case writeMutVar# var# val s1# of { s2# ->
(# s2#, () #) }
+
+-- Just pointer equality on mutable references:
+instance Eq (STRef s a) where
+ STRef v1# == STRef v2# = sameMutVar# v1# v2#
+\end{code}
+
+
+%*********************************************************
+%* *
+\subsection{The @Array@ types}
+%* *
+%*********************************************************
+
+\begin{code}
+type IPr = (Int, Int)
+
+data Ix i => Array i e = Array !i !i (Array# e)
+data Ix i => STArray s i e = STArray !i !i (MutableArray# s e)
+
+-- Just pointer equality on mutable arrays:
+instance Eq (STArray s i e) where
+ STArray _ _ arr1# == STArray _ _ arr2# =
+ sameMutableArray# arr1# arr2#
\end{code}
+
%*********************************************************
%* *
\subsection{Operations on immutable arrays}
%* *
%*********************************************************
-"array", "!" and "bounds" are basic; the rest can be defined in terms of them
+\begin{code}
+{-# NOINLINE arrEleBottom #-}
+arrEleBottom :: a
+arrEleBottom = error "(Array.!): undefined array element"
+
+{-# INLINE array #-}
+array :: Ix i => (i,i) -> [(i, e)] -> Array i e
+array (l,u) ies = unsafeArray (l,u) [(index (l,u) i, e) | (i, e) <- ies]
+
+{-# INLINE unsafeArray #-}
+unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> Array i e
+unsafeArray (l,u) ies = runST (ST $ \s1# ->
+ case rangeSize (l,u) of { I# n# ->
+ case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) ->
+ foldr (fill marr#) (done l u marr#) ies s2# }})
+
+{-# INLINE fill #-}
+fill :: MutableArray# s e -> (Int, e) -> STRep s a -> STRep s a
+fill marr# (I# i#, e) next s1# =
+ case writeArray# marr# i# e s1# of { s2# ->
+ next s2# }
+
+{-# INLINE done #-}
+done :: Ix i => i -> i -> MutableArray# s e -> STRep s (Array i e)
+done l u marr# s1# =
+ case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) ->
+ (# s2#, Array l u arr# #) }
+
+-- This is inefficient and I'm not sure why:
+-- listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es)
+-- The code below is better. It still doesn't enable foldr/build
+-- transformation on the list of elements; I guess it's impossible
+-- using mechanisms currently available.
+
+{-# INLINE listArray #-}
+listArray :: Ix i => (i,i) -> [e] -> Array i e
+listArray (l,u) es = runST (ST $ \s1# ->
+ case rangeSize (l,u) of { I# n# ->
+ case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) ->
+ let fillFromList i# xs s3# | i# ==# n# = s3#
+ | otherwise = case xs of
+ [] -> s3#
+ y:ys -> case writeArray# marr# i# y s3# of { s4# ->
+ fillFromList (i# +# 1#) ys s4# } in
+ case fillFromList 0# es s2# of { s3# ->
+ done l u marr# s3# }}})
+
+{-# INLINE (!) #-}
+(!) :: Ix i => Array i e -> i -> e
+arr@(Array l u _) ! i = unsafeAt arr (index (l,u) i)
+
+{-# INLINE unsafeAt #-}
+unsafeAt :: Ix i => Array i e -> Int -> e
+unsafeAt (Array _ _ arr#) (I# i#) =
+ case indexArray# arr# i# of (# e #) -> e
+
+{-# INLINE bounds #-}
+bounds :: Ix i => Array i e -> (i,i)
+bounds (Array l u _) = (l,u)
+
+{-# INLINE indices #-}
+indices :: Ix i => Array i e -> [i]
+indices (Array l u _) = range (l,u)
+
+{-# INLINE elems #-}
+elems :: Ix i => Array i e -> [e]
+elems arr@(Array l u _) =
+ [unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]]
+
+{-# INLINE assocs #-}
+assocs :: Ix i => Array i e -> [(i, e)]
+assocs arr@(Array l u _) =
+ [(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)]
+
+{-# INLINE accumArray #-}
+accumArray :: Ix i => (e -> a -> e) -> e -> (i,i) -> [(i, a)] -> Array i e
+accumArray f init (l,u) ies =
+ unsafeAccumArray f init (l,u) [(index (l,u) i, e) | (i, e) <- ies]
+
+{-# INLINE unsafeAccumArray #-}
+unsafeAccumArray :: Ix i => (e -> a -> e) -> e -> (i,i) -> [(Int, a)] -> Array i e
+unsafeAccumArray f init (l,u) ies = runST (ST $ \s1# ->
+ case rangeSize (l,u) of { I# n# ->
+ case newArray# n# init s1# of { (# s2#, marr# #) ->
+ foldr (adjust f marr#) (done l u marr#) ies s2# }})
+
+{-# INLINE adjust #-}
+adjust :: (e -> a -> e) -> MutableArray# s e -> (Int, a) -> STRep s b -> STRep s b
+adjust f marr# (I# i#, new) next s1# =
+ case readArray# marr# i# s1# of { (# s2#, old #) ->
+ case writeArray# marr# i# (f old new) s2# of { s3# ->
+ next s3# }}
+
+{-# INLINE (//) #-}
+(//) :: Ix i => Array i e -> [(i, e)] -> Array i e
+arr@(Array l u _) // ies =
+ unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies]
+
+{-# INLINE unsafeReplace #-}
+unsafeReplace :: Ix i => Array i e -> [(Int, e)] -> Array i e
+unsafeReplace arr@(Array l u _) ies = runST (do
+ STArray _ _ marr# <- thawSTArray arr
+ ST (foldr (fill marr#) (done l u marr#) ies))
+
+{-# INLINE accum #-}
+accum :: Ix i => (e -> a -> e) -> Array i e -> [(i, a)] -> Array i e
+accum f arr@(Array l u _) ies =
+ unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies]
+
+{-# INLINE unsafeAccum #-}
+unsafeAccum :: Ix i => (e -> a -> e) -> Array i e -> [(Int, a)] -> Array i e
+unsafeAccum f arr@(Array l u _) ies = runST (do
+ STArray _ _ marr# <- thawSTArray arr
+ ST (foldr (adjust f marr#) (done l u marr#) ies))
+
+{-# INLINE amap #-}
+amap :: Ix i => (a -> b) -> Array i a -> Array i b
+amap f arr@(Array l u _) =
+ unsafeArray (l,u) [(i, f (unsafeAt arr i)) | i <- [0 .. rangeSize (l,u) - 1]]
+
+{-# INLINE ixmap #-}
+ixmap :: (Ix i, Ix j) => (i,i) -> (i -> j) -> Array j e -> Array i e
+ixmap (l,u) f arr =
+ unsafeArray (l,u) [(unsafeIndex (l,u) i, arr ! f i) | i <- range (l,u)]
+
+{-# INLINE eqArray #-}
+eqArray :: (Ix i, Eq e) => Array i e -> Array i e -> Bool
+eqArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) =
+ if rangeSize (l1,u1) == 0 then rangeSize (l2,u2) == 0 else
+ l1 == l2 && u1 == u2 &&
+ and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. rangeSize (l1,u1) - 1]]
+
+{-# INLINE cmpArray #-}
+cmpArray :: (Ix i, Ord e) => Array i e -> Array i e -> Ordering
+cmpArray arr1 arr2 = compare (assocs arr1) (assocs arr2)
+
+{-# INLINE cmpIntArray #-}
+cmpIntArray :: Ord e => Array Int e -> Array Int e -> Ordering
+cmpIntArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) =
+ if rangeSize (l1,u1) == 0 then if rangeSize (l2,u2) == 0 then EQ else LT else
+ if rangeSize (l2,u2) == 0 then GT else
+ case compare l1 l2 of
+ EQ -> foldr cmp (compare u1 u2) [0 .. rangeSize (l1, min u1 u2) - 1]
+ other -> other
+ where
+ cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of
+ EQ -> rest
+ other -> other
+
+{-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-}
+\end{code}
+
+
+%*********************************************************
+%* *
+\subsection{Array instances}
+%* *
+%*********************************************************
\begin{code}
-bounds (Array b _) = b
+instance Ix i => Functor (Array i) where
+ fmap = amap
-(Array bounds arr#) ! i
- = let n# = case (index bounds i) of { I# x -> x } -- index fails if out of range
- in
- case (indexArray# arr# n#) of
- (# _, v #) -> v
+instance (Ix i, Eq e) => Eq (Array i e) where
+ (==) = eqArray
-#ifdef USE_FOLDR_BUILD
-{-# INLINE array #-}
-#endif
-array ixs@(ix_start, ix_end) ivs =
- runST ( ST $ \ s ->
- case (newArray ixs arrEleBottom) of { ST new_array_thing ->
- case (new_array_thing s) of { (# s#, arr@(MutableArray _ arr#) #) ->
- let
- fill_in s# [] = s#
- fill_in s# ((i,v):ivs) =
- case (index ixs i) of { I# n# ->
- case writeArray# arr# n# v s# of { s2# ->
- fill_in s2# ivs }}
- in
-
- case (fill_in s# ivs) of { s# ->
- case (freezeArray arr) of { ST freeze_array_thing ->
- freeze_array_thing s# }}}})
+instance (Ix i, Ord e) => Ord (Array i e) where
+ compare = cmpArray
-arrEleBottom = error "(Array.!): undefined array element"
+instance (Ix a, Show a, Show b) => Show (Array a b) where
+ showsPrec p a =
+ showParen (p > 9) $
+ showString "array " .
+ shows (bounds a) .
+ showChar ' ' .
+ shows (assocs a)
-fill_it_in :: Ix ix => MutableArray s ix elt -> [(ix, elt)] -> ST s ()
-fill_it_in arr lst
- = foldr fill_one_in (return ()) lst
- where -- **** STRICT **** (but that's OK...)
- fill_one_in (i, v) rst
- = writeArray arr i v >> rst
-
------------------------------------------------------------------------
--- these also go better with magic: (//), accum, accumArray
-
-old_array // ivs
- = runST (do
- -- copy the old array:
- arr <- thawArray old_array
- -- now write the new elements into the new array:
- fill_it_in arr ivs
- freezeArray arr
- )
- where
- bottom = error "(Array.//): error in copying old array\n"
-
-zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> MutableArray s ix elt -> [(ix,elt2)] -> ST s ()
--- zap_with_f: reads an elem out first, then uses "f" on that and the new value
-
-zap_with_f f arr lst
- = foldr zap_one (return ()) lst
- where
- zap_one (i, new_v) rst = do
- old_v <- readArray arr i
- writeArray arr i (f old_v new_v)
- rst
-
-accum f old_array ivs
- = runST (do
- -- copy the old array:
- arr <- thawArray old_array
- -- now zap the elements in question with "f":
- zap_with_f f arr ivs
- freezeArray arr
- )
- where
- bottom = error "Array.accum: error in copying old array\n"
-
-accumArray f zero ixs ivs
- = runST (do
- arr# <- newArray ixs zero
- zap_with_f f arr# ivs
- freezeArray arr#
- )
+{-
+instance (Ix a, Read a, Read b) => Read (Array a b) where
+ readsPrec p = readParen (p > 9)
+ (\r -> [(array b as, u) | ("array",s) <- lex r,
+ (b,t) <- reads s,
+ (as,u) <- reads t ])
+-}
\end{code}
%*********************************************************
Idle ADR question: What's the tradeoff here between flattening these
-datatypes into @MutableArray ix ix (MutableArray# s elt)@ and using
+datatypes into @STArray ix ix (MutableArray# s elt)@ and using
it as is? As I see it, the former uses slightly less heap and
provides faster access to the individual parts of the bounds while the
code used has the benefit of providing a ready-made @(lo, hi)@ pair as
might be different, though.
\begin{code}
-newArray :: Ix ix => (ix,ix) -> elt -> ST s (MutableArray s ix elt)
-newCharArray, newIntArray, newAddrArray, newFloatArray, newDoubleArray
- :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
-
-{-# SPECIALIZE newArray :: IPr -> elt -> ST s (MutableArray s Int elt),
- (IPr,IPr) -> elt -> ST s (MutableArray s IPr elt)
- #-}
-{-# SPECIALIZE newCharArray :: IPr -> ST s (MutableByteArray s Int) #-}
-{-# SPECIALIZE newIntArray :: IPr -> ST s (MutableByteArray s Int) #-}
-{-# SPECIALIZE newWordArray :: IPr -> ST s (MutableByteArray s Int) #-}
-{-# SPECIALIZE newAddrArray :: IPr -> ST s (MutableByteArray s Int) #-}
-{-# SPECIALIZE newFloatArray :: IPr -> ST s (MutableByteArray s Int) #-}
-{-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-}
-
-newArray ixs init = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
- case (newArray# n# init s#) of { (# s2#, arr# #) ->
- (# s2#, MutableArray ixs arr# #) }}
-
-newCharArray ixs = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
- case (newCharArray# n# s#) of { (# s2#, barr# #) ->
- (# s2#, MutableByteArray ixs barr# #) }}
-
-newIntArray ixs = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
- case (newIntArray# n# s#) of { (# s2#, barr# #) ->
- (# s2#, MutableByteArray ixs barr# #) }}
-
-newWordArray ixs = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
- case (newWordArray# n# s#) of { (# s2#, barr# #) ->
- (# s2#, MutableByteArray ixs barr# #) }}
-
-newAddrArray ixs = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
- case (newAddrArray# n# s#) of { (# s2#, barr# #) ->
- (# s2#, MutableByteArray ixs barr# #) }}
-
-newFloatArray ixs = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
- case (newFloatArray# n# s#) of { (# s2#, barr# #) ->
- (# s2#, MutableByteArray ixs barr# #) }}
-
-newDoubleArray ixs = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
- case (newDoubleArray# n# s#) of { (# s2#, barr# #) ->
- (# s2#, MutableByteArray ixs barr# #) }}
-
-boundsOfArray :: Ix ix => MutableArray s ix elt -> (ix, ix)
-boundsOfByteArray :: Ix ix => MutableByteArray s ix -> (ix, ix)
-
-{-# SPECIALIZE boundsOfArray :: MutableArray s Int elt -> IPr #-}
-{-# SPECIALIZE boundsOfByteArray :: MutableByteArray s Int -> IPr #-}
-
-boundsOfArray (MutableArray ixs _) = ixs
-boundsOfByteArray (MutableByteArray ixs _) = ixs
-
-readArray :: Ix ix => MutableArray s ix elt -> ix -> ST s elt
-
-readCharArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Char
-readIntArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
-readWordArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Word
-readAddrArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr
-readFloatArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
-readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
-
-{-# SPECIALIZE readArray :: MutableArray s Int elt -> Int -> ST s elt,
- MutableArray s IPr elt -> IPr -> ST s elt
- #-}
-{-# SPECIALIZE readCharArray :: MutableByteArray s Int -> Int -> ST s Char #-}
-{-# SPECIALIZE readIntArray :: MutableByteArray s Int -> Int -> ST s Int #-}
-{-# SPECIALIZE readAddrArray :: MutableByteArray s Int -> Int -> ST s Addr #-}
---NO:{-# SPECIALIZE readFloatArray :: MutableByteArray s Int -> Int -> ST s Float #-}
-{-# SPECIALIZE readDoubleArray :: MutableByteArray s Int -> Int -> ST s Double #-}
-
-readArray (MutableArray ixs arr#) n = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
- case readArray# arr# n# s# of { (# s2#, r #) ->
- (# s2#, r #) }}
-
-readCharArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
- case readCharArray# barr# n# s# of { (# s2#, r# #) ->
- (# s2#, C# r# #) }}
-
-readIntArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
- case readIntArray# barr# n# s# of { (# s2#, r# #) ->
- (# s2#, I# r# #) }}
-
-readWordArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
- case readWordArray# barr# n# s# of { (# s2#, r# #) ->
- (# s2#, W# r# #) }}
-
-readAddrArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
- case readAddrArray# barr# n# s# of { (# s2#, r# #) ->
- (# s2#, A# r# #) }}
-
-readFloatArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
- case readFloatArray# barr# n# s# of { (# s2#, r# #) ->
- (# s2#, F# r# #) }}
-
-readDoubleArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
- case readDoubleArray# barr# n# s# of { (# s2#, r# #) ->
- (# s2#, D# r# #) }}
-
---Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
-indexCharArray :: Ix ix => ByteArray ix -> ix -> Char
-indexIntArray :: Ix ix => ByteArray ix -> ix -> Int
-indexWordArray :: Ix ix => ByteArray ix -> ix -> Word
-indexAddrArray :: Ix ix => ByteArray ix -> ix -> Addr
-indexFloatArray :: Ix ix => ByteArray ix -> ix -> Float
-indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double
-
-{-# SPECIALIZE indexCharArray :: ByteArray Int -> Int -> Char #-}
-{-# SPECIALIZE indexIntArray :: ByteArray Int -> Int -> Int #-}
-{-# SPECIALIZE indexAddrArray :: ByteArray Int -> Int -> Addr #-}
---NO:{-# SPECIALIZE indexFloatArray :: ByteArray Int -> Int -> Float #-}
-{-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-}
-
-indexCharArray (ByteArray ixs barr#) n
- = case (index ixs n) of { I# n# ->
- case indexCharArray# barr# n# of { r# ->
- (C# r#)}}
-
-indexIntArray (ByteArray ixs barr#) n
- = case (index ixs n) of { I# n# ->
- case indexIntArray# barr# n# of { r# ->
- (I# r#)}}
-
-indexWordArray (ByteArray ixs barr#) n
- = case (index ixs n) of { I# n# ->
- case indexWordArray# barr# n# of { r# ->
- (W# r#)}}
-
-indexAddrArray (ByteArray ixs barr#) n
- = case (index ixs n) of { I# n# ->
- case indexAddrArray# barr# n# of { r# ->
- (A# r#)}}
-
-indexFloatArray (ByteArray ixs barr#) n
- = case (index ixs n) of { I# n# ->
- case indexFloatArray# barr# n# of { r# ->
- (F# r#)}}
-
-indexDoubleArray (ByteArray ixs barr#) n
- = case (index ixs n) of { I# n# ->
- case indexDoubleArray# barr# n# of { r# ->
- (D# r#)}}
-
-writeArray :: Ix ix => MutableArray s ix elt -> ix -> elt -> ST s ()
-writeCharArray :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s ()
-writeIntArray :: Ix ix => MutableByteArray s ix -> ix -> Int -> ST s ()
-writeWordArray :: Ix ix => MutableByteArray s ix -> ix -> Word -> ST s ()
-writeAddrArray :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s ()
-writeFloatArray :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s ()
-writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s ()
-
-{-# SPECIALIZE writeArray :: MutableArray s Int elt -> Int -> elt -> ST s (),
- MutableArray s IPr elt -> IPr -> elt -> ST s ()
- #-}
-{-# SPECIALIZE writeCharArray :: MutableByteArray s Int -> Int -> Char -> ST s () #-}
-{-# SPECIALIZE writeIntArray :: MutableByteArray s Int -> Int -> Int -> ST s () #-}
-{-# SPECIALIZE writeAddrArray :: MutableByteArray s Int -> Int -> Addr -> ST s () #-}
---NO:{-# SPECIALIZE writeFloatArray :: MutableByteArray s Int -> Int -> Float -> ST s () #-}
-{-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-}
-
-writeArray (MutableArray ixs arr#) n ele = ST $ \ s# ->
- case index ixs n of { I# n# ->
- case writeArray# arr# n# ele s# of { s2# ->
- (# s2#, () #) }}
-
-writeCharArray (MutableByteArray ixs barr#) n (C# ele) = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
- case writeCharArray# barr# n# ele s# of { s2# ->
- (# s2#, () #) }}
-
-writeIntArray (MutableByteArray ixs barr#) n (I# ele) = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
- case writeIntArray# barr# n# ele s# of { s2# ->
- (# s2#, () #) }}
-
-writeWordArray (MutableByteArray ixs barr#) n (W# ele) = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
- case writeWordArray# barr# n# ele s# of { s2# ->
- (# s2#, () #) }}
-
-writeAddrArray (MutableByteArray ixs barr#) n (A# ele) = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
- case writeAddrArray# barr# n# ele s# of { s2# ->
- (# s2#, () #) }}
-
-writeFloatArray (MutableByteArray ixs barr#) n (F# ele) = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
- case writeFloatArray# barr# n# ele s# of { s2# ->
- (# s2#, () #) }}
-
-writeDoubleArray (MutableByteArray ixs barr#) n (D# ele) = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
- case writeDoubleArray# barr# n# ele s# of { s2# ->
- (# s2#, () #) }}
+{-# INLINE newSTArray #-}
+newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)
+newSTArray (l,u) init = ST $ \s1# ->
+ case rangeSize (l,u) of { I# n# ->
+ case newArray# n# init s1# of { (# s2#, marr# #) ->
+ (# s2#, STArray l u marr# #) }}
+
+{-# INLINE boundsSTArray #-}
+boundsSTArray :: STArray s i e -> (i,i)
+boundsSTArray (STArray l u _) = (l,u)
+
+{-# INLINE readSTArray #-}
+readSTArray :: Ix i => STArray s i e -> i -> ST s e
+readSTArray marr@(STArray l u _) i =
+ unsafeReadSTArray marr (index (l,u) i)
+
+{-# INLINE unsafeReadSTArray #-}
+unsafeReadSTArray :: Ix i => STArray s i e -> Int -> ST s e
+unsafeReadSTArray (STArray _ _ marr#) (I# i#) = ST $ \s1# ->
+ readArray# marr# i# s1#
+
+{-# INLINE writeSTArray #-}
+writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s ()
+writeSTArray marr@(STArray l u _) i e =
+ unsafeWriteSTArray marr (index (l,u) i) e
+
+{-# INLINE unsafeWriteSTArray #-}
+unsafeWriteSTArray :: Ix i => STArray s i e -> Int -> e -> ST s ()
+unsafeWriteSTArray (STArray _ _ marr#) (I# i#) e = ST $ \s1# ->
+ case writeArray# marr# i# e s1# of { s2# ->
+ (# s2#, () #) }
\end{code}
%*********************************************************
\begin{code}
-{-
-freezeArray :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
-freezeCharArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-freezeIntArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-freezeWordArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-freezeAddrArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-
-{-# SPECIALISE freezeArray :: MutableArray s Int elt -> ST s (Array Int elt),
- MutableArray s IPr elt -> ST s (Array IPr elt)
- #-}
-{-# SPECIALISE freezeCharArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
--}
-freezeArray (MutableArray ixs arr#) = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
- case freeze arr# n# s# of { (# s2#, frozen# #) ->
- (# s2#, Array ixs frozen# #) }}
- where
- freeze :: MutableArray# s ele -- the thing
- -> Int# -- size of thing to be frozen
- -> State# s -- the Universe and everything
- -> (# State# s, Array# ele #)
- freeze arr# n# s#
- = case newArray# n# init s# of { (# s2#, newarr1# #) ->
- case copy 0# n# arr# newarr1# s2# of { (# s3#, newarr2# #) ->
- unsafeFreezeArray# newarr2# s3#
- }}
- where
- init = error "freezeArray: element not copied"
-
- copy :: Int# -> Int#
- -> MutableArray# s ele
- -> MutableArray# s ele
- -> State# s
- -> (# State# s, MutableArray# s ele #)
-
- copy cur# end# from# to# s#
- | cur# ==# end#
- = (# s#, to# #)
- | otherwise
- = case readArray# from# cur# s# of { (# s1#, ele #) ->
- case writeArray# to# cur# ele s1# of { s2# ->
- copy (cur# +# 1#) end# from# to# s2#
- }}
-
-freezeCharArray (MutableByteArray ixs arr#) = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
- case freeze arr# n# s# of { (# s2#, frozen# #) ->
- (# s2#, ByteArray ixs frozen# #) }}
- where
- freeze :: MutableByteArray# s -- the thing
- -> Int# -- size of thing to be frozen
- -> State# s -- the Universe and everything
- -> (# State# s, ByteArray# #)
-
- freeze arr# n# s#
- = case (newCharArray# n# s#) of { (# s2#, newarr1# #) ->
- case copy 0# n# arr# newarr1# s2# of { (# s3#, newarr2# #) ->
- unsafeFreezeByteArray# newarr2# s3#
- }}
- where
- copy :: Int# -> Int#
- -> MutableByteArray# s -> MutableByteArray# s
- -> State# s
- -> (# State# s, MutableByteArray# s #)
-
- copy cur# end# from# to# s#
- | cur# ==# end#
- = (# s#, to# #)
- | otherwise
- = case (readCharArray# from# cur# s#) of { (# s1#, ele #) ->
- case (writeCharArray# to# cur# ele s1#) of { s2# ->
- copy (cur# +# 1#) end# from# to# s2#
- }}
-
-freezeIntArray (MutableByteArray ixs arr#) = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
- case freeze arr# n# s# of { (# s2#, frozen# #) ->
- (# s2#, ByteArray ixs frozen# #) }}
- where
- freeze :: MutableByteArray# s -- the thing
- -> Int# -- size of thing to be frozen
- -> State# s -- the Universe and everything
- -> (# State# s, ByteArray# #)
-
- freeze arr# n# s#
- = case (newIntArray# n# s#) of { (# s2#, newarr1# #) ->
- case copy 0# n# arr# newarr1# s2# of { (# s3#, newarr2# #) ->
- unsafeFreezeByteArray# newarr2# s3#
- }}
- where
- copy :: Int# -> Int#
- -> MutableByteArray# s -> MutableByteArray# s
- -> State# s
- -> (# State# s, MutableByteArray# s #)
-
- copy cur# end# from# to# s#
- | cur# ==# end#
- = (# s#, to# #)
- | otherwise
- = case (readIntArray# from# cur# s#) of { (# s1#, ele #) ->
- case (writeIntArray# to# cur# ele s1#) of { s2# ->
- copy (cur# +# 1#) end# from# to# s2#
- }}
-
-freezeWordArray (MutableByteArray ixs arr#) = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
- case freeze arr# n# s# of { (# s2#, frozen# #) ->
- (# s2#, ByteArray ixs frozen# #) }}
- where
- freeze :: MutableByteArray# s -- the thing
- -> Int# -- size of thing to be frozen
- -> State# s -- the Universe and everything
- -> (# State# s, ByteArray# #)
-
- freeze arr# n# s#
- = case (newWordArray# n# s#) of { (# s2#, newarr1# #) ->
- case copy 0# n# arr# newarr1# s2# of { (# s3#, newarr2# #) ->
- unsafeFreezeByteArray# newarr2# s3#
- }}
- where
- copy :: Int# -> Int#
- -> MutableByteArray# s -> MutableByteArray# s
- -> State# s
- -> (# State# s, MutableByteArray# s #)
-
- copy cur# end# from# to# s#
- | cur# ==# end#
- = (# s#, to# #)
- | otherwise
- = case (readWordArray# from# cur# s#) of { (# s1#, ele #) ->
- case (writeWordArray# to# cur# ele s1#) of { s2# ->
- copy (cur# +# 1#) end# from# to# s2#
- }}
-
-freezeAddrArray (MutableByteArray ixs arr#) = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
- case freeze arr# n# s# of { (# s2#, frozen# #) ->
- (# s2#, ByteArray ixs frozen# #) }}
- where
- freeze :: MutableByteArray# s -- the thing
- -> Int# -- size of thing to be frozen
- -> State# s -- the Universe and everything
- -> (# State# s, ByteArray# #)
-
- freeze arr# n# s#
- = case (newAddrArray# n# s#) of { (# s2#, newarr1# #) ->
- case copy 0# n# arr# newarr1# s2# of { (# s3#, newarr2# #) ->
- unsafeFreezeByteArray# newarr2# s3#
- }}
- where
- copy :: Int# -> Int#
- -> MutableByteArray# s -> MutableByteArray# s
- -> State# s
- -> (# State# s, MutableByteArray# s #)
-
- copy cur# end# from# to# s#
- | cur# ==# end#
- = (# s#, to# #)
- | otherwise
- = case (readAddrArray# from# cur# s#) of { (# s1#, ele #) ->
- case (writeAddrArray# to# cur# ele s1#) of { s2# ->
- copy (cur# +# 1#) end# from# to# s2#
- }}
-
-unsafeFreezeArray :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
-unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-
-{-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
- #-}
-
-unsafeFreezeArray (MutableArray ixs arr#) = ST $ \ s# ->
- case unsafeFreezeArray# arr# s# of { (# s2#, frozen# #) ->
- (# s2#, Array ixs frozen# #) }
-
-unsafeFreezeByteArray (MutableByteArray ixs arr#) = ST $ \ s# ->
- case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
- (# s2#, ByteArray ixs frozen# #) }
-
-
---This takes a immutable array, and copies it into a mutable array, in a
---hurry.
-
-{-# SPECIALISE thawArray :: Array Int elt -> ST s (MutableArray s Int elt),
- Array IPr elt -> ST s (MutableArray s IPr elt)
- #-}
-
-thawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
-thawArray (Array ixs arr#) = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
- case thaw arr# n# s# of { (# s2#, thawed# #) ->
- (# s2#, MutableArray ixs thawed# #)}}
- where
- thaw :: Array# ele -- the thing
- -> Int# -- size of thing to be thawed
- -> State# s -- the Universe and everything
- -> (# State# s, MutableArray# s ele #)
-
- thaw arr# n# s#
- = case newArray# n# init s# of { (# s2#, newarr1# #) ->
- copy 0# n# arr# newarr1# s2# }
- where
- init = error "thawArray: element not copied"
-
- copy :: Int# -> Int#
- -> Array# ele
- -> MutableArray# s ele
- -> State# s
- -> (# State# s, MutableArray# s ele #)
-
- copy cur# end# from# to# s#
- | cur# ==# end#
- = (# s#, to# #)
- | otherwise
- = case indexArray# from# cur# of { (# _, ele #) ->
- case writeArray# to# cur# ele s# of { s1# ->
- copy (cur# +# 1#) end# from# to# s1#
- }}
-
+freezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)
+freezeSTArray (STArray l u marr#) = ST $ \s1# ->
+ case rangeSize (l,u) of { I# n# ->
+ case newArray# n# arrEleBottom s1# of { (# s2#, marr'# #) ->
+ let copy i# s3# | i# ==# n# = s3#
+ | otherwise =
+ case readArray# marr# i# s3# of { (# s4#, e #) ->
+ case writeArray# marr'# i# e s4# of { s5# ->
+ copy (i# +# 1#) s5# }} in
+ case copy 0# s2# of { s3# ->
+ case unsafeFreezeArray# marr'# s3# of { (# s4#, arr# #) ->
+ (# s4#, Array l u arr# #) }}}}
+
+{-# INLINE unsafeFreezeSTArray #-}
+unsafeFreezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)
+unsafeFreezeSTArray (STArray l u marr#) = ST $ \s1# ->
+ case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) ->
+ (# s2#, Array l u arr# #) }
+
+thawSTArray :: Ix i => Array i e -> ST s (STArray s i e)
+thawSTArray (Array l u arr#) = ST $ \s1# ->
+ case rangeSize (l,u) of { I# n# ->
+ case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) ->
+ let copy i# s3# | i# ==# n# = s3#
+ | otherwise =
+ case indexArray# arr# i# of { (# e #) ->
+ case writeArray# marr# i# e s3# of { s4# ->
+ copy (i# +# 1#) s4# }} in
+ case copy 0# s2# of { s3# ->
+ (# s3#, STArray l u marr# #) }}}
+
+{-# INLINE unsafeThawSTArray #-}
+unsafeThawSTArray :: Ix i => Array i e -> ST s (STArray s i e)
+unsafeThawSTArray (Array l u arr#) = ST $ \s1# ->
+ case unsafeThawArray# arr# s1# of { (# s2#, marr# #) ->
+ (# s2#, STArray l u marr# #) }
\end{code}
projects / ghc-hetmet.git / blobdiff