[Haskell-cafe] Building a monoid, continuation-passing style
David Menendez
dave at zednenem.com
Tue Sep 15 21:07:13 EDT 2009
On Mon, Sep 14, 2009 at 11:25 AM, Martijn van Steenbergen
<martijn at van.steenbergen.nl> wrote:
> Inspired by Sean Leather's xformat package [1] I built a datatype with which
> you can build a monoid with holes, yielding a function type to fill in these
> holes, continuation-passing style.
Neat!
> I have a couple of questions:
> * ContSt is a Category. Is it also an Arrow? Why (not)?
I think it isn't. To be an Arrow, you need a definition for first, and
to write first you need to be able to transform a function of type f r
-> a into a function of type f (r,b) -> (a,b), which I'm pretty sure
is impossible.
> * What is its relation with the Cont and Reader monads?
I'm reminded of the parameterized monad of continuations that Oleg
mentioned a few years back.
<http://www.haskell.org/pipermail/haskell/2007-December/020034.html>
Here's one way of expressing it:
class Paramonad m where
ret :: a -> m x x a
bind :: m x y a -> (a -> m y z b) -> m x z b
liftP2 :: (Paramonad m) => (a -> b -> c) -> m x y a -> m y z b -> m x z c
liftP2 (*) m1 m2 = m1 `bind` \a -> m2 `bind` \b -> ret (a * b)
newtype Cont x y a = Cont { runCont :: (a -> y) -> x }
run :: Cont x a a -> x
run m = runCont m id
instance Paramonad Cont where
ret a = Cont $ \k -> k a
m `bind` f = Cont $ \k -> runCont m (\a -> runCont (f a) k)
shift :: ((a -> Cont z z y) -> Cont x b b) -> Cont x y a
shift f = Cont $ \k -> run $ f (ret . k)
(<>) :: Monoid m => Cont x y m -> Cont y z m -> Cont x z m
(<>) = liftP2 mappend
later :: (a -> m) -> Cont (a -> r) r m
later f = shift $ \k -> ret (run . k . f)
-- equivalently,
-- later f = Cont $ \k -> k . f
> run (ret "x" <> ret "y")
"xy"
> run (ret "x" <> later id) "y"
"xy"
and so forth.
In fact, this is a good candidate for an alternative implementation.
newtype ContSt m r a = ContSt (Cont a r m)
It would be interesting to compare their relative efficiency.
> * ContSt is a horrible name. What is a better one?
HoleyMonoid?
--
Dave Menendez <dave at zednenem.com>
<http://www.eyrie.org/~zednenem/>
More information about the Haskell-Cafe
mailing list