[Haskell-cafe] Interpreter with Cont
David Menendez
dave at zednenem.com
Mon Nov 21 06:08:56 CET 2011
On Sat, Nov 19, 2011 at 3:29 PM, Felipe Almeida Lessa
<felipe.lessa at gmail.com> wrote:
> On Sat, Nov 19, 2011 at 6:08 PM, Tim Baumgartner
> <baumgartner.tim at googlemail.com> wrote:
>> I have not yet gained a good understanding of the continuation monad, but I
>> wonder if it could be used here. What would a clean solution look like?
>> Perhaps there are other things that need to be changed as well?
>
> Your 'Interaction' data type is actually an instance of the more
> general "operational monad" (as named by Heinrich Apfelmus) or "prompt
> monad" (as named by Ryan Ingram).
Both of which are just disguised free monads. For reference:
data Free f a = Val a | Wrap (f (Free f a))
foldFree :: Functor f => (a -> b) -> (f b -> b) -> Free f a -> b
foldFree v w (Val a) = v a
foldFree v w (Wrap t) = w $ fmap (foldFree v w) t
instance Functor f => Monad (Free f) where
return = Val
m >>= f = foldFree f Wrap m
To use Free, just find the signature functor for Interaction by
replacing the recursive instances with a new type variable,
data InteractionF a b x = ExitF b
| OutputF b x
| InputF (a -> x)
instance Functor (InteractionF a b) where
fmap f (ExitF b) = ExitF b
fmap f (OutputF b x) = OutputF b (f x)
fmap f (InputF g) = InputF (f . g)
roll :: InteractionF a b (Interaction a b) -> Interaction a b
roll (ExitF b) = Exit b
roll (OutputF b x) = Output b x
roll (InputF g) = Input g
type InteractionM a b = Free (InteractionF a b)
runM :: InteractionM a b b -> Interaction a b
runM = foldFree Exit roll
exit :: b -> InteractionM a b c
exit b = Wrap (ExitF b)
output :: b -> InteractionM a b ()
output b = Wrap (OutputF b (Val ()))
input :: InteractionM a b a
input = Wrap (InputF Val)
--
Dave Menendez <dave at zednenem.com>
<http://www.eyrie.org/~zednenem/>
More information about the Haskell-Cafe
mailing list