Ertugrul Söylemez es at ertes.de
Tue Mar 12 12:53:37 CET 2013

```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.

coroutines, and there are better monads for that purpose.  This is how

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
y <- if x /= 15
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

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