[Haskell-cafe] (state) monad and CPS
Ryan Ingram
ryani.spam at gmail.com
Wed Nov 11 01:09:47 EST 2009
Something like this should work:
newtype ContState r s a = ContState { runCS :: s -> (a -> s -> r) -> r }
instance Monad (ContState r s) where
return a = ContState $ \s k -> k a s
m >>= f = ContState $ \s0 k -> runCS m s $ \a s1 -> runCS (f a) s1 k
instance MonadState s (ContState r s) where
get = ContState $ \s k -> k s s
put s = ContState $ \_ k -> k () s
instance MonadCont (ContState r s) where
callCC f = ContState $ \s0 ka -> runCS (f $ \a -> ContState $ \s1
kb -> ka a s1) s0 ka
There's a design choice as to whether the inner continuation should be
called with s0 or s1; it depends if you want the continuation from
callCC to abort any state changes or preserve them up to that point.
-- ryan
On Tue, Nov 10, 2009 at 12:18 PM, jean-christophe mincke
<jeanchristophe.mincke at gmail.com> wrote:
> Hello,
>
> I would like to get some advice about state monad (or any other monad I
> guess) and CPS.
>
> Let's take a simple exemple (see the code below)
>
> '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.
> 'walk2' is does the same using the state monad but is not written in CPS
>
> Is it possible to write a function 'walk3' written in CPS and using the
> state monad?
>
> Thank you
>
> Regards
>
> J-C
>
>
> module M where
>
> import Control.Monad.State
>
> data Node =
> Node (Node, Int, Node)
> |Leaf Int
> |Empty
> deriving (Show)
>
> walk Empty acc k = k acc
> walk (Leaf _) acc k = k (acc+1)
> walk (Node (l, _, r)) acc k = let k1 acc = walk r acc k
> in
> walk l (acc+1) k1
>
>
> nb = Node (Leaf 1, 2, Leaf 3)
> nd = Node (nb, 4, Empty)
>
> nh = Node (Empty, 8, Leaf 9)
> ng = Node (Leaf 6, 7, nh)
>
> ne = Node (nd, 5, ng)
>
> r = walk ne 0 id
>
> walk2 Empty = return ()
> walk2 (Leaf _ ) = do acc <- get
> put (acc+1)
> return ()
> walk2 (Node (l, _, r)) = do acc <- get
> put (acc+1)
> walk2 l
> walk2 r
> return ()
>
>
> r2 = runState (walk2 ne) 0
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>
More information about the Haskell-Cafe
mailing list