[Haskell-cafe] Cont, ContT and IO()

Thomas Schilling nominolo at googlemail.com
Fri Jul 3 21:33:48 EDT 2009


Here's some code I wrote the other day:

hasCycle :: (Applicative m, MonadIO m) => Node -> m Bool
hasCycle n0 = runContT (*callCC* go) return
 where
  go *abort* = do visit [] IM.empty n0
                return False
    where
      visit preds h n = do
        nid <- nodeId n
        h' <- foldM (\h' n' -> do
                   n'id <- nodeId n'
                   case IM.lookup n'id h' of
                     Just True -> *abort* True
                     Just False -> return h'
                     Nothing -> visit (n:preds) h n')
                (IM.insert nid True h) =<< nodeChildren n
        return (IM.insert nid False h')

This function returns True if the graph starting at n0 has cycles.  You can
ignore the details; take a look at the use of "abort".  The type of "abort"
is Bool -> m (IM.IntMap Bool) but the result type is actually irrelevant
since this function will never return.  The effect of calling "abort" is to:
jump back to the place where we called callCC and replace the call with the
value we passed to "abort".

You can think of callCC of creating a snapshot of the program's current
execution state.  This snapshot (called the "current continuation") is
passed to the function that was the argument to "callCC" ("go" in the
above).  This snapshot is represented as a function and you can call it.

If you call the continuation, two things happen:

 1. The currently executed code is aborted.
 2. The execution jumps back to the state in which callCC was called and the
call to callCC gets replaced by the value you passed to the continuation.

Naturally, we cannot undo IO effects, so not all of the state is reset.
Also, since callCC is only available in the monad, it only saves the
snapshot up to the closest "runContT".

Another, more mind-bending feature of continuations is that you can store
them and invoke them *multiple times*.  But that is a story for another day.

HTH

2009/7/4 Günther Schmidt <gue.schmidt at web.de>:
>
> Hi,
>
> I've got an IO action, some file system IO, traversing one level only and
> iterating over files found. I wish to build in an "early" exit, ie. if an
IO
> action in the loop encounters a particular value I want it to abort the
> loop.
>
> Now so far, pls don't shoot, I have done this by throwing IO Exceptions
and
> catching them. I'm trying to rewrite this using Continuatios / callCC but
> can't figure out where to place what.
>
> I certainly don't have the intuition yet and funny enough not even in RWH
I
> could find some Cont/ContT examples.
>
> Would someone please draw me an example?
>
> Günther
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>



-- 
Push the envelope.  Watch it bend.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20090703/f3ddacda/attachment.html


More information about the Haskell-Cafe mailing list