Actually we stack up other monad transformers on it for interesting things
such as state. We do it like StateT s (Cont y), although we get
similar behaviour with ContT y (State s) because instance lifting
code is written to commute them.
import Control.Monad.Cont > import Control.Monad.State.Strict > import Control.Monad.Reader > import Control.Monad ]]>
m b) -> m a) -> m a ]]>
Or, 3rd-rank polymorphic implementation
m b) -> m a) -> m a) ]]>
Typical usage:
.... c x1 ... return x0) ... ]]>
In this code, m b]]> and
x0,x1,x :: a
Think of c x1 as an action for early exit.
If execution hits c x1, we exit early and x becomes
x1.
Otherwise, normal exit means x becomes x0.
Note that c x1 :: m b with unconstrained b,
so it can blend into its context.
(Clearly, it doesn't really return a value of type b; execution
jumps elsewhere and this is just type checking.)
In this example, starting from initial state n, the loop increases it
until the state becomes 5, then exits and returns that value. Note
that c s :: m () to satisfy the type of when.
loop :: (Monad m) => m a -> m b
> loop p = fix (p >>)
> fun :: Int -> Int
> fun n = runCont (evalStateT p n) id
> where
> p = do
> { callCC $ \c -> loop $ do
> { modify (+ 1)
> ; s <- get
> ; when (s == 5) (c s)
> }
> }
]]>
This example is more advanced. Can we "leak" c to the outer
scope and use it elsewhere? Yes.
c still needs to be applied to some argument, let's call
that x for now. (We will solve for x soon.) It's
more convenient to return c x, and the user just needs to bind it
to l and execute it later. When c x is executed,
execution jumps back to its callCC origin, and x is
returned and bound to the user's l, and it should be
c x again so that the whole thing is repeatable.
Therefore we have x = c x = fix c.
Typing: l, fix c :: m b,
c :: m b -> m b. In this example b = Int by
blending into the if-then-else.
setjmp :: (MonadCont m) => m (m b)
> setjmp = callCC (\c -> return (fix c))
> jumpy :: Int -> Int
> jumpy n = runCont (evalStateT p n) id
> where
> p = do
> { l <- setjmp
> ; modify (+ 1)
> ; s <- get
> ; if s == 5 then return s else l
> }
]]>
Exception throwing and handling is a close cousin of callCC.
Here we implement it. The action to be protected needs to know how to throw an
exception; here we assume it takes a thrower as a parameter, and it
calls the provided thrower when it wants to. Inside callCC,
which provides c, we can define the thrower to run a handler
and then use c to exit early;
now we can run the action with this thrower.
We use this to take square roots repeatedly of the state until it is close enough to 1; for states 0 or negative, we throw an exception, and the handler returns 0 or NaN respectively.
catchC :: (MonadCont m) =>
> ((e -> m b) -> m a) -- action, takes a thrower parameter
> -> (e -> m a) -- handler
> -> m a
> catchC action handler = callCC (\c -> action (\e -> handler e >>= c))
> data Bad = Zero | Neg deriving Show
> catchme :: Double -> Double
> catchme n = runCont (evalStateT p n) id
> where
> p = do
> { catchC q handler
> }
> q throw = do
> { s <- get
> ; when (s < 0) (throw Neg)
> ; when (s <= 0) (throw Zero)
> ; l <- setjmp
> ; t <- get
> ; if abs(t - 1) < 0.01 then return t else modify sqrt >> l
> }
> handler Zero = return 0
> handler Neg = return (sqrt (-1))
]]>
It is bothersome to mandate every protected action to take a thrower parameter. Now we tag on a ReaderT layer to make throwers implicit. As a bonus we also get to install a "top level" handler.
Doing this introduces an infinite type. (The monad is a MonadReader of
the thrower, and the thrower mentions that monad again.) A lightweight
way of untying this is to be specific about our monad stack (RSC
below) and newtyping the thrower. There are more advanced solutions.
type RSC e s y = ReaderT (Thrower e s y) (StateT s (Cont y)) > newtype Thrower e s y = Thrower (e -> RSC e s y ()) ]]>
The throw command throwI asks for the thrower from the environment
and executes it.
The thrower returns (). The throw command returns an arbitrary
b to blend into its caller context. This gap can be bridged by
appending a meaningless polymorphic action after the thrower. (Alternative
solution: the Thrower type is
RSC e s y b)]]>,
and callCC needs to be 2nd-rank too.)
throwI :: e -> RSC e s y b
> throwI e = do
> { Thrower thrower <- ask
> ; thrower e
> ; undefined
> }
]]>
The catch command catchI constructs the new thrower from the
handler and uses it as the new environment for running the action. The thrower
calls the handler and then jumps outside, as in the previous example. But in
addition the handler needs to be arranged to run under the old environment so
that it can "re-throw" exceptions. (If we don't code this up, the handler is
run under the new environment (because it's called by the action under the
new environment), and re-throwing causes looping.) This is seamlessly done
with "local", which not only shadows the old environment, but also lets us
map from the old to the new, so we can actually say we are constructing the
new thrower from the old.
catchI :: RSC e s y a > -> (e -> RSC e s y a) > -> RSC e s y a > catchI action handler = > callCC (\c -> local (mkt c) action) > where mkt c r = Thrower (\e -> with r (handler e >>= c)) > with r m = local (const r) m ]]>
This example usage takes square roots of the state until it's close to 1. For 0 or negative states, we throw an exception. Like the previous example, in the 0 case we return 0. Unlike the previous example, in the negative case we re-throw the exception to demonstrate that re-throwing works its way to the outer handler.
exceptional :: Double -> Double
> exceptional n = runCont (evalStateT (runReaderT p topthrow) n) id
> where
> topthrow = Thrower (\e -> error ("unhandled exception " ++ show e))
> p = do
> { catchI q handler
> }
> q = do
> { s <- get
> ; when (s < 0) (throwI Neg)
> ; when (s <= 0) (throwI Zero)
> ; l <- setjmp
> ; t <- get
> ; if abs(t - 1) < 0.01 then return t else modify sqrt >> l
> }
> handler Zero = return 0
> handler Neg = throwI Neg
]]>
I have more Haskell Notes and Examples