<html><body style="word-wrap: break-word; -webkit-nbsp-mode: space; -webkit-line-break: after-white-space; ">Yes; check out the module "Control.Monad.Cont", which has a monad for continuation passing style.<div><br></div><div>In particular, note that most of the monads in Control.Monad.* are "stackable" in that there is a version of the monad which you can stack on top of an existing monad. So for example, you could use ContT to stack the CPS monad on top of the State monad, or StateT to stack the State monad on top of the CPS monad.</div><div><br></div><div>Hope this helps,</div><div>Greg</div><div><br></div><div><br></div><div><div>On Nov 10, 2009, at 12:18 PM, jean-christophe mincke wrote:</div><br class="Apple-interchange-newline"><blockquote type="cite">Hello,<br><br>I would like to get some advice about state monad (or any other monad I guess) and CPS.<br><br>Let's take a simple exemple (see the code below)<br><br>'walk' is a function written in CPS that compute the number of nodes & leaves in a tree. It use a counter which is explicitly passed through calls.<br> 'walk2' is does the same using the state monad but is not written in CPS<br><br>Is it possible to write a function 'walk3' written in CPS and using the state monad? <br><br>Thank you<br><br>Regards<br><br> J-C<br><br><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">module M where</span><br style="font-family: courier new,monospace;"><br style="font-family: courier new,monospace;"> <span style="font-family: courier new,monospace;">import Control.Monad.State</span><br style="font-family: courier new,monospace;"><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">data Node = </span><br style="font-family: courier new,monospace;"> <span style="font-family: courier new,monospace;"> Node (Node, Int, Node)</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> |Leaf Int</span><br style="font-family: courier new,monospace;"> <span style="font-family: courier new,monospace;"> |Empty</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> deriving (Show)</span><br style="font-family: courier new,monospace;"> <span style="font-family: courier new,monospace;"> </span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">walk Empty acc k = k acc</span><br style="font-family: courier new,monospace;"> <span style="font-family: courier new,monospace;">walk (Leaf _) acc k = k (acc+1)</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">walk (Node (l, _, r)) acc k = let k1 acc = walk r acc k</span><br style="font-family: courier new,monospace;"> <span style="font-family: courier new,monospace;"> in </span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> walk l (acc+1) k1</span><br style="font-family: courier new,monospace;"> <span style="font-family: courier new,monospace;"> </span><br style="font-family: courier new,monospace;"><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">nb = Node (Leaf 1, 2, Leaf 3)</span><br style="font-family: courier new,monospace;"> <span style="font-family: courier new,monospace;">nd = Node (nb, 4, Empty)</span><br style="font-family: courier new,monospace;"><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">nh = Node (Empty, 8, Leaf 9)</span><br style="font-family: courier new,monospace;"> <span style="font-family: courier new,monospace;">ng = Node (Leaf 6, 7, nh)</span><br style="font-family: courier new,monospace;"><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">ne = Node (nd, 5, ng)</span><br style="font-family: courier new,monospace;"> <br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">r = walk ne 0 id</span><br style="font-family: courier new,monospace;"><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">walk2 Empty = return ()</span><br style="font-family: courier new,monospace;"> <span style="font-family: courier new,monospace;">walk2 (Leaf _ ) = do acc <- get</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> put (acc+1)</span><br style="font-family: courier new,monospace;"> <span style="font-family: courier new,monospace;"> return ()</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">walk2 (Node (l, _, r)) = do acc <- get</span><br style="font-family: courier new,monospace;"> <span style="font-family: courier new,monospace;"> put (acc+1)</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> walk2 l</span><br style="font-family: courier new,monospace;"> <span style="font-family: courier new,monospace;"> walk2 r</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> return ()</span><br style="font-family: courier new,monospace;"> <span style="font-family: courier new,monospace;"> </span><br style="font-family: courier new,monospace;"><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">r2 = runState (walk2 ne) 0 </span><br> <br> _______________________________________________<br>Haskell-Cafe mailing list<br><a href="mailto:Haskell-Cafe@haskell.org">Haskell-Cafe@haskell.org</a><br><a href="http://www.haskell.org/mailman/listinfo/haskell-cafe">http://www.haskell.org/mailman/listinfo/haskell-cafe</a><br></blockquote></div><br></body></html>