Array implementation, @PrelArr@ exports the basic array
types and operations.
+For byte-arrays see @PrelByteArr@.
+
\begin{code}
{-# OPTIONS -fno-implicit-prelude #-}
import PrelList (foldl)
import PrelST
import PrelBase
-import PrelCCall
import PrelAddr
import PrelGHC
+import PrelShow
infixl 9 !, //
+
+default ()
\end{code}
\begin{code}
{-# 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)
-
{-# SPECIALISE (//) :: Array Int b -> [(Int,b)] -> Array Int b #-}
(//) :: (Ix a) => Array a b -> [(a,b)] -> Array a b
{-# 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
+
+bounds :: (Ix a) => Array a b -> (a,a)
+assocs :: (Ix a) => Array a b -> [(a,b)]
+indices :: (Ix a) => Array a b -> [a]
\end{code}
\begin{code}
type IPr = (Int, Int)
-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)
+data Ix ix => Array ix elt = Array ix ix (Array# elt)
+data Ix ix => STArray s ix elt = STArray ix ix (MutableArray# s elt)
-instance CCallable (MutableByteArray s ix)
-instance CCallable (MutableByteArray# s)
-instance CCallable (ByteArray ix)
-instance CCallable ByteArray#
+data STRef s a = STRef (MutVar# s a)
-data MutableVar s a = MutableVar (MutVar# s a)
-
-instance Eq (MutableVar s a) where
- MutableVar v1# == MutableVar v2#
+instance Eq (STRef s a) where
+ STRef v1# == STRef v2#
= sameMutVar# v1# v2#
-- just pointer equality on arrays:
-instance Eq (MutableArray s ix elt) where
- MutableArray _ _ arr1# == MutableArray _ _ arr2#
+instance Eq (STArray s ix elt) where
+ STArray _ _ arr1# == STArray _ _ arr2#
= sameMutableArray# arr1# arr2#
-
-instance Eq (MutableByteArray s ix) where
- MutableByteArray _ _ arr1# == MutableByteArray _ _ arr2#
- = sameMutableByteArray# arr1# arr2#
\end{code}
%*********************************************************
%*********************************************************
\begin{code}
-newVar :: a -> ST s (MutableVar s a)
-readVar :: MutableVar s a -> ST s a
-writeVar :: MutableVar s a -> a -> ST s ()
+newSTRef :: a -> ST s (STRef s a)
+readSTRef :: STRef s a -> ST s a
+writeSTRef :: STRef s a -> a -> ST s ()
-newVar init = ST $ \ s# ->
+newSTRef init = ST $ \ s# ->
case (newMutVar# init s#) of { (# s2#, var# #) ->
- (# s2#, MutableVar var# #) }
+ (# s2#, STRef var# #) }
-readVar (MutableVar var#) = ST $ \ s# -> readMutVar# var# s#
+readSTRef (STRef var#) = ST $ \ s# -> readMutVar# var# s#
-writeVar (MutableVar var#) val = ST $ \ s# ->
+writeSTRef (STRef var#) val = ST $ \ s# ->
case writeMutVar# var# val s# of { s2# ->
(# s2#, () #) }
\end{code}
"array", "!" and "bounds" are basic; the rest can be defined in terms of them
\begin{code}
+{-# INLINE bounds #-}
bounds (Array l u _) = (l,u)
+{-# INLINE assocs #-} -- Want to fuse the list comprehension
+assocs a = [(i, a!i) | i <- indices a]
+
+{-# INLINE indices #-}
+indices = range . bounds
+
+{-# SPECIALISE amap :: (b -> c) -> Array Int b -> Array Int c #-}
+amap :: (Ix a) => (b -> c) -> Array a b -> Array a c
+amap f a = array b [(i, f (a!i)) | i <- range b]
+ where b = bounds a
+
(Array l u arr#) ! i
= let n# = case (index (l,u) i) of { I# x -> x } -- index fails if out of range
in
old_array // ivs
= runST (do
-- copy the old array:
- arr <- thawArray old_array
+ arr <- thawSTArray old_array
-- now write the new elements into the new array:
fill_it_in arr ivs
- freezeArray arr
+ freezeSTArray arr
)
-fill_it_in :: Ix ix => MutableArray s ix elt -> [(ix, elt)] -> ST s ()
+fill_it_in :: Ix ix => STArray s ix elt -> [(ix, elt)] -> ST s ()
{-# INLINE fill_it_in #-}
fill_it_in arr lst = foldr (fill_one_in arr) (return ()) lst
-- **** STRICT **** (but that's OK...)
-fill_one_in arr (i, v) rst = writeArray arr i v >> rst
+fill_one_in arr (i, v) rst = writeSTArray arr i v >> rst
-zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> MutableArray s ix elt -> [(ix,elt2)] -> ST s ()
+zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> STArray s ix elt -> [(ix,elt2)] -> ST s ()
-- zap_with_f: reads an elem out first, then uses "f" on that and the new value
{-# INLINE zap_with_f #-}
= foldr (zap_one f arr) (return ()) lst
zap_one f arr (i, new_v) rst = do
- old_v <- readArray arr i
- writeArray arr i (f old_v new_v)
+ old_v <- readSTArray arr i
+ writeSTArray arr i (f old_v new_v)
rst
{-# INLINE accum #-}
accum f old_array ivs
= runST (do
-- copy the old array:
- arr <- thawArray old_array
+ arr <- thawSTArray old_array
-- now zap the elements in question with "f":
zap_with_f f arr ivs
- freezeArray arr
+ freezeSTArray arr
)
{-# INLINE accumArray #-}
accumArray f zero ixs ivs
= runST (do
- arr <- newArray ixs zero
+ arr <- newSTArray ixs zero
zap_with_f f arr ivs
- freezeArray arr
+ freezeSTArray arr
)
\end{code}
%*********************************************************
%* *
+\subsection{Array instances}
+%* *
+%*********************************************************
+
+
+\begin{code}
+instance Ix a => Functor (Array a) where
+ fmap = amap
+
+instance (Ix a, Eq b) => Eq (Array a b) where
+ a == a' = assocs a == assocs a'
+ a /= a' = assocs a /= assocs a'
+
+instance (Ix a, Ord b) => Ord (Array a b) where
+ compare a b = compare (assocs a) (assocs b)
+
+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) )
+ showList = showList__ (showsPrec 0)
+
+{-
+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 ])
+ readList = readList__ (readsPrec 0)
+-}
+\end{code}
+
+
+%*********************************************************
+%* *
\subsection{Operations on mutable arrays}
%* *
%*********************************************************
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, newWordArray, newAddrArray, newFloatArray, newDoubleArray
- :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
+newSTArray :: Ix ix => (ix,ix) -> elt -> ST s (STArray s ix elt)
-{-# SPECIALIZE newArray :: IPr -> elt -> ST s (MutableArray s Int elt),
- (IPr,IPr) -> elt -> ST s (MutableArray s IPr elt)
+{-# SPECIALIZE newSTArray :: IPr -> elt -> ST s (STArray s Int elt),
+ (IPr,IPr) -> elt -> ST s (STArray 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 (l,u) init = ST $ \ s# ->
+newSTArray (l,u) init = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
case (newArray# n# init s#) of { (# s2#, arr# #) ->
- (# s2#, MutableArray l u arr# #) }}
-
-newCharArray (l,u) = ST $ \ s# ->
- case rangeSize (l,u) of { I# n# ->
- case (newCharArray# n# s#) of { (# s2#, barr# #) ->
- (# s2#, MutableByteArray l u barr# #) }}
+ (# s2#, STArray l u arr# #) }}
-newIntArray (l,u) = ST $ \ s# ->
- case rangeSize (l,u) of { I# n# ->
- case (newIntArray# n# s#) of { (# s2#, barr# #) ->
- (# s2#, MutableByteArray l u barr# #) }}
-newWordArray (l,u) = ST $ \ s# ->
- case rangeSize (l,u) of { I# n# ->
- case (newWordArray# n# s#) of { (# s2#, barr# #) ->
- (# s2#, MutableByteArray l u barr# #) }}
-newAddrArray (l,u) = ST $ \ s# ->
- case rangeSize (l,u) of { I# n# ->
- case (newAddrArray# n# s#) of { (# s2#, barr# #) ->
- (# s2#, MutableByteArray l u barr# #) }}
+boundsSTArray :: Ix ix => STArray s ix elt -> (ix, ix)
+{-# SPECIALIZE boundsSTArray :: STArray s Int elt -> IPr #-}
+boundsSTArray (STArray l u _) = (l,u)
-newFloatArray (l,u) = ST $ \ s# ->
- case rangeSize (l,u) of { I# n# ->
- case (newFloatArray# n# s#) of { (# s2#, barr# #) ->
- (# s2#, MutableByteArray l u barr# #) }}
-
-newDoubleArray (l,u) = ST $ \ s# ->
- case rangeSize (l,u) of { I# n# ->
- case (newDoubleArray# n# s#) of { (# s2#, barr# #) ->
- (# s2#, MutableByteArray l u barr# #) }}
-
-boundsOfArray :: Ix ix => MutableArray s ix elt -> (ix, ix)
-
-{-# SPECIALIZE boundsOfArray :: MutableArray s Int elt -> IPr #-}
-
-boundsOfArray (MutableArray l u _) = (l,u)
-
-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
+readSTArray :: Ix ix => STArray s ix elt -> ix -> ST s elt
+{-# SPECIALIZE readSTArray :: STArray s Int elt -> Int -> ST s elt,
+ STArray 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 l u arr#) n = ST $ \ s# ->
+readSTArray (STArray l u arr#) n = ST $ \ s# ->
case (index (l,u) n) of { I# n# ->
case readArray# arr# n# s# of { (# s2#, r #) ->
(# s2#, r #) }}
-readCharArray (MutableByteArray l u barr#) n = ST $ \ s# ->
- case (index (l,u) n) of { I# n# ->
- case readCharArray# barr# n# s# of { (# s2#, r# #) ->
- (# s2#, C# r# #) }}
-
-readIntArray (MutableByteArray l u barr#) n = ST $ \ s# ->
- case (index (l,u) n) of { I# n# ->
- case readIntArray# barr# n# s# of { (# s2#, r# #) ->
- (# s2#, I# r# #) }}
-
-readWordArray (MutableByteArray l u barr#) n = ST $ \ s# ->
- case (index (l,u) n) of { I# n# ->
- case readWordArray# barr# n# s# of { (# s2#, r# #) ->
- (# s2#, W# r# #) }}
-
-readAddrArray (MutableByteArray l u barr#) n = ST $ \ s# ->
- case (index (l,u) n) of { I# n# ->
- case readAddrArray# barr# n# s# of { (# s2#, r# #) ->
- (# s2#, A# r# #) }}
-
-readFloatArray (MutableByteArray l u barr#) n = ST $ \ s# ->
- case (index (l,u) n) of { I# n# ->
- case readFloatArray# barr# n# s# of { (# s2#, r# #) ->
- (# s2#, F# r# #) }}
-
-readDoubleArray (MutableByteArray l u barr#) n = ST $ \ s# ->
- case (index (l,u) 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 l u barr#) n
- = case (index (l,u) n) of { I# n# ->
- case indexCharArray# barr# n# of { r# ->
- (C# r#)}}
-
-indexIntArray (ByteArray l u barr#) n
- = case (index (l,u) n) of { I# n# ->
- case indexIntArray# barr# n# of { r# ->
- (I# r#)}}
-
-indexWordArray (ByteArray l u barr#) n
- = case (index (l,u) n) of { I# n# ->
- case indexWordArray# barr# n# of { r# ->
- (W# r#)}}
-
-indexAddrArray (ByteArray l u barr#) n
- = case (index (l,u) n) of { I# n# ->
- case indexAddrArray# barr# n# of { r# ->
- (A# r#)}}
-
-indexFloatArray (ByteArray l u barr#) n
- = case (index (l,u) n) of { I# n# ->
- case indexFloatArray# barr# n# of { r# ->
- (F# r#)}}
-
-indexDoubleArray (ByteArray l u barr#) n
- = case (index (l,u) 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 ()
+writeSTArray :: Ix ix => STArray s ix elt -> ix -> elt -> ST s ()
+{-# SPECIALIZE writeSTArray :: STArray s Int elt -> Int -> elt -> ST s (),
+ STArray 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 l u arr#) n ele = ST $ \ s# ->
+writeSTArray (STArray l u arr#) n ele = ST $ \ s# ->
case index (l,u) n of { I# n# ->
case writeArray# arr# n# ele s# of { s2# ->
(# s2#, () #) }}
-
-writeCharArray (MutableByteArray l u barr#) n (C# ele) = ST $ \ s# ->
- case index (l,u) n of { I# n# ->
- case writeCharArray# barr# n# ele s# of { s2# ->
- (# s2#, () #) }}
-
-writeIntArray (MutableByteArray l u barr#) n (I# ele) = ST $ \ s# ->
- case index (l,u) n of { I# n# ->
- case writeIntArray# barr# n# ele s# of { s2# ->
- (# s2#, () #) }}
-
-writeWordArray (MutableByteArray l u barr#) n (W# ele) = ST $ \ s# ->
- case index (l,u) n of { I# n# ->
- case writeWordArray# barr# n# ele s# of { s2# ->
- (# s2#, () #) }}
-
-writeAddrArray (MutableByteArray l u barr#) n (A# ele) = ST $ \ s# ->
- case index (l,u) n of { I# n# ->
- case writeAddrArray# barr# n# ele s# of { s2# ->
- (# s2#, () #) }}
-
-writeFloatArray (MutableByteArray l u barr#) n (F# ele) = ST $ \ s# ->
- case index (l,u) n of { I# n# ->
- case writeFloatArray# barr# n# ele s# of { s2# ->
- (# s2#, () #) }}
-
-writeDoubleArray (MutableByteArray l u barr#) n (D# ele) = ST $ \ s# ->
- case index (l,u) n of { I# n# ->
- case writeDoubleArray# barr# n# ele s# 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)
+freezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
+{-# SPECIALISE freezeSTArray :: STArray s Int elt -> ST s (Array Int elt),
+ STArray s IPr elt -> ST s (Array IPr elt)
#-}
-{-# SPECIALISE freezeCharArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
-freezeArray (MutableArray l u arr#) = ST $ \ s# ->
+freezeSTArray (STArray l u arr#) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
case freeze arr# n# s# of { (# s2#, frozen# #) ->
(# s2#, Array l u frozen# #) }}
copy (cur# +# 1#) end# from# to# s2#
}}
-freezeCharArray (MutableByteArray l u arr#) = ST $ \ s# ->
- case rangeSize (l,u) of { I# n# ->
- case freeze arr# n# s# of { (# s2#, frozen# #) ->
- (# s2#, ByteArray l u frozen# #) }}
- where
- freeze :: MutableByteArray# s -- the thing
- -> Int# -- size of thing to be frozen
- -> State# s -- the Universe and everything
- -> (# State# s, ByteArray# #)
-
- freeze arr1# n# s1#
- = case (newCharArray# n# s1#) of { (# s2#, newarr1# #) ->
- case copy 0# n# arr1# 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# st#
- | cur# ==# end#
- = (# st#, to# #)
- | otherwise
- = case (readCharArray# from# cur# st#) of { (# s2#, ele #) ->
- case (writeCharArray# to# cur# ele s2#) of { s3# ->
- copy (cur# +# 1#) end# from# to# s3#
- }}
-
-freezeIntArray (MutableByteArray l u arr#) = ST $ \ s# ->
- case rangeSize (l,u) of { I# n# ->
- case freeze arr# n# s# of { (# s2#, frozen# #) ->
- (# s2#, ByteArray l u frozen# #) }}
- where
- freeze :: MutableByteArray# s -- the thing
- -> Int# -- size of thing to be frozen
- -> State# s -- the Universe and everything
- -> (# State# s, ByteArray# #)
-
- freeze m_arr# n# s#
- = case (newIntArray# n# s#) of { (# s2#, newarr1# #) ->
- case copy 0# n# m_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# s1#
- | cur# ==# end#
- = (# s1#, to# #)
- | otherwise
- = case (readIntArray# from# cur# s1#) of { (# s2#, ele #) ->
- case (writeIntArray# to# cur# ele s2#) of { s3# ->
- copy (cur# +# 1#) end# from# to# s3#
- }}
-
-freezeWordArray (MutableByteArray l u arr#) = ST $ \ s# ->
- case rangeSize (l,u) of { I# n# ->
- case freeze arr# n# s# of { (# s2#, frozen# #) ->
- (# s2#, ByteArray l u frozen# #) }}
- where
- freeze :: MutableByteArray# s -- the thing
- -> Int# -- size of thing to be frozen
- -> State# s -- the Universe and everything
- -> (# State# s, ByteArray# #)
-
- freeze m_arr# n# s1#
- = case (newWordArray# n# s1#) of { (# s2#, newarr1# #) ->
- case copy 0# n# m_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# st#
- | cur# ==# end# = (# st#, to# #)
- | otherwise =
- case (readWordArray# from# cur# st#) of { (# s2#, ele #) ->
- case (writeWordArray# to# cur# ele s2#) of { s3# ->
- copy (cur# +# 1#) end# from# to# s3#
- }}
-
-freezeAddrArray (MutableByteArray l u arr#) = ST $ \ s# ->
- case rangeSize (l,u) of { I# n# ->
- case freeze arr# n# s# of { (# s2#, frozen# #) ->
- (# s2#, ByteArray l u frozen# #) }}
- where
- freeze :: MutableByteArray# s -- the thing
- -> Int# -- size of thing to be frozen
- -> State# s -- the Universe and everything
- -> (# State# s, ByteArray# #)
-
- freeze m_arr# n# s1#
- = case (newAddrArray# n# s1#) of { (# s2#, newarr1# #) ->
- case copy 0# n# m_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# st#
- | cur# ==# end#
- = (# st#, to# #)
- | otherwise
- = case (readAddrArray# from# cur# st#) of { (# st1#, ele #) ->
- case (writeAddrArray# to# cur# ele st1#) of { st2# ->
- copy (cur# +# 1#) end# from# to# st2#
- }}
-
-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 l u arr#) = ST $ \ s# ->
+unsafeFreezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
+unsafeFreezeSTArray (STArray l u arr#) = ST $ \ s# ->
case unsafeFreezeArray# arr# s# of { (# s2#, frozen# #) ->
(# s2#, Array l u frozen# #) }
-unsafeFreezeByteArray (MutableByteArray l u arr#) = ST $ \ s# ->
- case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
- (# s2#, ByteArray l u 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)
+thawSTArray :: Ix ix => Array ix elt -> ST s (STArray s ix elt)
+{-# SPECIALISE thawSTArray :: Array Int elt -> ST s (STArray s Int elt),
+ Array IPr elt -> ST s (STArray s IPr elt)
#-}
-thawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
-thawArray (Array l u arr#) = ST $ \ s# ->
+thawSTArray (Array l u arr#) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
case thaw arr# n# s# of { (# s2#, thawed# #) ->
- (# s2#, MutableArray l u thawed# #)}}
+ (# s2#, STArray l u thawed# #)}}
where
thaw :: Array# ele -- the thing
-> Int# -- size of thing to be thawed
= case newArray# n# init s# of { (# s2#, newarr1# #) ->
copy 0# n# arr1# newarr1# s2# }
where
- init = error "thawArray: element not copied"
+ init = error "thawSTArray: element not copied"
copy :: Int# -> Int#
-> Array# ele
-- this is a quicker version of the above, just flipping the type
-- (& representation) of an immutable array. And placing a
-- proof obligation on the programmer.
-unsafeThawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
-unsafeThawArray (Array l u arr#) = ST $ \ s# ->
+unsafeThawSTArray :: Ix ix => Array ix elt -> ST s (STArray s ix elt)
+unsafeThawSTArray (Array l u arr#) = ST $ \ s# ->
case unsafeThawArray# arr# s# of
- (# s2#, marr# #) -> (# s2#, MutableArray l u marr# #)
+ (# s2#, marr# #) -> (# s2#, STArray l u marr# #)
\end{code}
projects / ghc-hetmet.git / blobdiff