[Haskell-cafe] Control.Monad.Cont fun
oleg at pobox.com
oleg at pobox.com
Mon Jul 25 22:14:47 EDT 2005
On Thu, Jul 07, 2005 at 07:08:23PM +0200, Tomasz Zielonka wrote:
> Some time ago I wanted to return the escape continuation out of the
> callCC block, like this:
>
> getCC = callCC (\c -> return c)
It seems using shift/reset is better not only in principle but in
practice as well.
> module Foo where
>
> import Control.Monad.Cont
>
> -- From http://www.haskell.org/hawiki/MonadCont
> reset :: (Monad m) => ContT a m a -> ContT r m a
> reset e = ContT $ \k -> runContT e return >>= k
>
> shift :: (Monad m) =>
> ((a -> ContT r m b) -> ContT b m b)
> -> ContT b m a
> shift e = ContT $ \k ->
> runContT (e $ \v -> ContT $ \c -> k v >>= c) return
We can define a more general getCC' form simply as follows:
> getCC' init = shift (\f -> f (init,jump f))
> where jump f x = f (x,jump f)
The compiler figures out the types.
Here's the usage example from the original Tomasz's message
> test1' :: IO ()
> test1' = (`runContT` return) $
> do
> reset (do
> (x, jump) <- getCC' 0
> lift (print x)
> when (x < 10) $ jump (x + 1))
> lift (putStrLn "finish")
That was using the ContT monad exactly as it comes with GHC 6.4.
With the CC_CPST monad transformer (with multiple polymorphic
prompts) we can do better:
> getCCP' p init = shiftP p (\f -> f (return (init,jump f)))
> where jump f x = f (return (x,jump f))
The following code (written a couple of weeks) prints 1 through 10,
then again 4 through 10 and then again 5 through 10, and then
"finish". So we can not only note a label to jump to: we can return
the label so to jump to it from different `functions'. In a sense, we
emulate multiple entry points to a block and cross-block jumps.
> test1'' :: IO ()
> test1'' = runCC (
> do
> p <- newPrompt
> p1 <- newPrompt
> j <- pushPrompt p1 ( pushPrompt p (
> do
> (x, jump) <- getCCP' p 0
> lift (print x)
> when (x < 10) $ jump (x+1)
> shiftP p1 (const (return jump))) >> undefined)
> lift (putStrLn "again")
> pushPrompt p1 (j 4 >> undefined)
> lift (putStrLn "and again")
> pushPrompt p1 (j 5 >> undefined)
> lift (putStrLn "finish"))
In this terminating code, undefined plays a great role.
More information about the Haskell-Cafe
mailing list