[Haskell-cafe] traversing a tree using monad.cont

Luke Palmer lrpalmer at gmail.com
Sat May 2 05:33:58 EDT 2009


On Sat, May 2, 2009 at 3:13 AM, Anatoly Yakovenko <aeyakovenko at gmail.com>wrote:

> > Though I don't fully understand what you are doing (specifically what you
> > mean by "specific order"), but in a lazy language, traversals are usually
> > simply encoded as lists.  Just write a function which returns all the
> leaves
> > as a list, and filter over it.
>
> yea, i know, i am trying to learn how to use the Cont monad. or
> continuation in haskell.  The idea is that while i am processing some
> data i may hit a point whree some dependency isn't met and i want to
> take a different branch via continuation.  I expect that branch to
> furfill my dependency and when its done i want to continue down the
> original branch


Ah I see.  Well, in my opinion, Cont is almost never the right answer.
 Others, who have an easier time thinking about continuations, may differ.

In any case, you are stating your problem very imperatively, which may be
why you feel inclined to use continuations.  E.g. "when it's done I want to
continue down the original branch" is talking about control flow.

Maybe you really just want to do a topological sort of some data in your
tree?

How is the tree structure related to the dependencies?  How is the tree
structure related to your traversal?  E.g. are you using a combining
function on each branch to a value over its subtrees?

Basically I think "do a traversal" is not enough information to answer your
question.  What is the relationship of the contents of the tree to the
*contents
*of the traversal?

Luke




>
>
> >> module TestCont where
> >> import Control.Monad.Cont
> >> import Control.Monad.Identity
> >> import Control.Monad.State.Lazy
> >>
> >> --our stupid tree
> >> data Tree a = Tree [Tree a]
> >>            | Leaf a
> >>
> >> --traverse all the branches
> >> search (Tree ts) next = do
> >>   mapM_ (\ ti -> (callCC (search ti))) ts
> >>   next $ ()
> >>
> >> search tt@(Leaf a) next = do
> >>   cur <- lift get
> >>   case ((cur + 1) == a) of
> >>      True -> do --the current leaf is what we want, update the state and
> return
>
> this is where i succeed in my current branch, so i can just do my thing and
> exit
>
> >>         lift $ put a
> >>         return $ ()
> >>      False -> do --the current leaf is not what we want, continue first,
> then try again
>
> this is where i fail, so i want to take the "other" branch first
> expecting it to fulfill my dependency.
>
> >>         next ()
> >>         search tt (\ _ -> error "fail")
> >>
> >> t1 = Leaf 1
> >> t2 = Leaf 2
> >> t3 = Tree [t1,t2]
> >> t4 = Leaf 3
> >> t5::Tree Int = Tree [t4,t3]
> >>
> >> run =  runIdentity (runStateT ((runContT $ callCC (search t5)) return)
> 0)
>
>
> but i think next doesn't do exactly what i think it does
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20090502/e5d0a907/attachment.htm


More information about the Haskell-Cafe mailing list