[Haskell-beginners] Suspend/resume computation using Cont monad and callCC

[Ertugrul Söylemez]

Dmitriy Matrosov <sgf.dma at gmail.com> wrote:

> I have two functions f and g, and i want them to execute in following
> order: first function f runs, then suspends and passes control to
> function g. Function g runs, then suspends and "unpauses" function f.
> Function f finishes and passes control to function g, which also
> finishes. Here is illustration ('o' means start of function, dot means
> suspend and pass control to other function, 'x' means end of
> function):
>
> [...]
>
> I want to implement this using Cont monad and callCC.

Not directly answering your question, but what you need is called
coroutines, and there are better monads for that purpose.  This is how
the Cont monads are defined:

    newtype Cont r a = Cont ((a -> r) -> r)

But what you really need here is called a Coroutine monad:

    newtype Coroutine f a = Coroutine (Either (f (Coroutine f a)) a)

Don't worry about that scary type, because if you look closely you will
find that this is just Free as defined in the 'free' package:

    data Free f a
        = Free (f (Free f a))
        | Pure a

This is how it works:  The computation either results in a value (Pure)
or it returns a way to continue the computation wrapped in `f` (Free):

    Free (Identity (Pure 15))

This computation suspends with the continuation "Pure 15".  If you
continue it, it will result in 15.  Of course there are some helper
functions to ease defining continuations:

    liftF (Identity 15)

So first you need a functor.  The monad-coroutine package has coined the
term "suspension functor" for this particular purpose.  It captures the
nature of the suspension.  As you saw the Identity functor allows you to
suspend and resume:

    type Suspend = Identity

    suspend :: Free Suspend ()
    suspend = liftF (Suspend ())

or even more generally:

    suspend :: (Applicative f) => Free f ()
    suspend = liftF (pure ())

You can use this in a computation:

    doStuff
    suspend
    doOtherStuff
    suspend
    return 15

This returns to the controller and allows it to resume the computation
if it wishes to:

    loop :: Free Suspend Integer -> IO Integer
    loop (Pure x) = return x
    loop (Free (Identity k)) = do
        putStrLn "Suspended."
        loop k

You can also define an abortion functor (predefined in
Data.Functor.Constant from the "transformers" package):

    newtype Constant r a = Constant r
        deriving (Functor)

    abort :: r -> Free (Constant r) a
    abort = Free . Constant

You will find that in a loop you don't receive a continuation, but
instead an abortion value, much like in a Cont computation that ignores
its continuation:

    loop :: Free (Constant Integer) Integer -> IO Integer
    loop (Pure x) = putStrLn "Completed" >> return x
    loop (Free (Constant x)) = do
        putStrLn ("Aborted with: " ++ show x)
        return x

Another possibility is a functor to request values of a certain type:

    type Request = (->)

    request :: Free (Request e) a
    request = Free Pure

Now the controlling loop has to supply values when requested to do so:

    comp :: Free (Request String) Integer
    comp = do
        x <- fmap read request
        y <- if x /= 15
               then fmap read request
               else return 5
        return (x + y)

    loop :: Free (Request String) Integer -> IO Integer
    loop (Pure x) = return x
    loop (Free k) = do
        putStrLn "Gimme something:"
        getLine >>= loop . k

Optionally add a prompt:

    data Prompt e a = Prompt String (e -> a)
        deriving (Functor)

    prompt :: String -> Free (Prompt e) e
    prompt p = Free (Prompt p Pure)

    loop :: Free (Prompt String) Integer -> IO Integer
    loop (Pure x) = return x
    loop (Free (Prompt p k)) = do
        putStrLn p
        getLine >>= loop . k

With a type system extension you can even request arbitrary IO actions:

    data Run a = forall b. Run (IO b) (b -> a)

    requestIO :: IO a -> Free Run a
    requestIO c = Free (Run c Pure)

    loop :: Free Run Integer -> IO Integer
    loop (Pure x) = return x
    loop (Free (Run c k)) = do
        putStrLn "IO action requested."
        c >>= loop . k

And you can yield values:

    type Yield = (,)

    yield :: v -> Free (Yield v) ()
    yield x = Free (x, Pure ())

    loop :: Free (Yield String) Integer -> IO Integer
    loop (Pure x) = return x
    loop (Free (str, k)) = do
        putStrLn ("Yielded: " ++ str)
        loop k

Or both request and yield (comonad-transformers package):

    type MySusp v e = Coproduct (Yield v) (Request e)

    yield :: v -> Free (MySusp v e) ()
    yield x = Free . Coproduct . Left $ (x, Pure ())

    request :: Free (MySusp v e) e
    request = Free . Coproduct . Right $ Pure

    loop :: Free (MySusp String String) Integer -> IO Integer
    loop (Pure x) = return x
    loop (Free (Coproduct f)) =
        case f of
          Left (x, k) -> do
              putStrLn ("Yielded " ++ x)
              loop k
          Right k -> do
              putStrLn "Requested."
              getLine >>= loop . k

There are many more ways to use Free, but this should give you the basic
building blocks.

I hope it helps.


Greets,
Ertugrul

-- 
Not to be or to be and (not to be or to be and (not to be or to be and
(not to be or to be and ... that is the list monad.
-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 836 bytes
Desc: not available
URL: <http://www.haskell.org/pipermail/beginners/attachments/20130312/ac0c98a9/attachment.pgp>