This library provides support for both lazy and strict state
threads, as described in the PLDI '94 paper by John Launchbury and
Simon Peyton Jones [LazyStateThreads]. In addition to the
monad ST
, it also provides mutable variables STRef
and
mutable arrays STArray
. As the name suggests, the monad ST
instance is lazy.
module LazyST( module LazyST, module Monad ) where
import Monad
data ST s a -- abstract type
runST :: forall a. (forall s. ST s a) -> a
returnST :: a -> ST s a
thenLazyST :: ST s a -> (a -> ST s b) -> ST s b
thenStrictST :: ST s a -> (a -> ST s b) -> ST s b
fixST :: (a -> ST s a) -> ST s a
unsafeInterleaveST :: ST s a -> ST s a
instance Functor (ST s)
instance Monad (ST s)
data STRef s a -- mutable variables in state thread s
-- containing values of type a.
newSTRef :: a -> ST s (STRef s a)
readSTRef :: STRef s a -> ST s a
writeSTRef :: STRef s a -> a -> ST s ()
instance Eq (STRef s a)
data STArray s ix elt -- mutable arrays in state thread s
-- indexed by values of type ix
-- containing values of type a.
newSTArray :: Ix ix => (ix,ix) -> elt -> ST s (STArray s ix elt)
boundsSTArray :: Ix ix => STArray s ix elt -> (ix, ix)
readSTArray :: Ix ix => STArray s ix elt -> ix -> ST s elt
writeSTArray :: Ix ix => STArray s ix elt -> ix -> elt -> ST s ()
thawSTArray :: Ix ix => Array ix elt -> ST s (STArray s ix elt)
freezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
unsafeFreezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
instance Eq (STArray s ix elt)
Notes:
freezeSTArray
and thawSTArray
convert mutable
arrays to and from immutable arrays. Semantically, they are identical
to copying the array and they are usually implemented that way. The
operation unsafeFreezeSTArray
is a faster version of
freezeSTArray
which omits the copying step. It's a safe substitute for
freezeSTArray
if you don't modify the mutable array after freezing it.
runST
operation,
used to specify encapsulation, is implemented as a language construct,
and runST
is treated as a keyword. We plan to change this to match
GHC soon.
ST
monad is in their bind operators. The monadic bind operators
thenLazyST
and thenStrictST
are provided so that you can
import LazyST
(say) and still use the strict instance in those
places where it matters. GHC also allows you to write LazyST.>>=
and ST.>>=
but this is not supported by Hugs yet.