[Haskell-cafe] Using a monad to decompose a function into
functions
David Menendez
dave at zednenem.com
Fri Mar 13 13:26:15 EDT 2009
2009/3/13 Marcin Kosiba <marcin.kosiba at gmail.com>:
>
> Threading the state is not the problem. Maybe this will help:
> what I have now:
>
> fsm world state = case state of
> first ->
> do_stuff_one
> (move_up, succ state)
> second ->
> do_stuff_two
> (move_left, succ state)
> third ->
> do_stuff_three
> (move_right, first)
>
> what I'd want to have is to say:
> fsm world state = do
> do_stuff_one
> yield move_up
> do_stuff_two
> yield move_left
> do_stuff_three
> yield move_right
> fsm world state
>
> and have it "translated" to:
>
> fsm world state =
> do_stuff_one
> (move_up, \world' state' ->
> do_stuff_two
> (move_left, \world'' state'' ->
> do_stuff_three
> (move_right, fsm world'' state'')
Do you really need yield? Most of the time, you should be able to
implement move_up and the rest directly using bits of the run
function.
But assuming you do need yield, you probably want a resumption monad.
Here's a variant of an implementation I've worked with recently.
data Thunk r m a = Val a | Suspend r (m (Thunk r m a))
newtype Suspend r m a = C { unC :: forall b. (a -> m (Thunk r m a)) ->
m (Thunk r m a) }
instance Monad (Suspend r m) where
return a = C (\k -> k a)
m >>= f = C (\k -> unC m (\a -> unC (f a) k))
instance MonadTrans (Suspend r) where
lift m = C (\k -> m >>= k)
suspend :: Monad m => r -> Suspend r m ()
suspend r = C (\k -> return $ Suspend r (k ()))
run :: Monad m => Suspend r m a -> m (Thunk r m a)
run m = unC m (return . Val)
These laws should give an idea of how it works:
run (return a) = return (Val a)
run (lift m >>= f) = m >>= \a -> run (f a)
run (suspend r >> m) = return (Suspend r (run m))
There's also a function that undoes run, although you shouldn't need it.
enter :: Monad m => Thunk r m a -> Suspend r m a
enter (Val a) = return a
enter (Suspend r m) = suspend r >> lift m >>= enter
--
Dave Menendez <dave at zednenem.com>
<http://www.eyrie.org/~zednenem/>
More information about the Haskell-Cafe
mailing list