On Sat, May 2, 2009 at 3:13 AM, Anatoly Yakovenko
<aeyakovenko@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