Cont as Monoid
David Menendez
zednenem at psualum.com
Sun Sep 9 16:15:56 EDT 2007
On 9/9/07, Conal Elliott <conal at conal.net> wrote:
> > "Cont (Endo b) a" is the usual backtracking monad.
>
> It is? Would you say more about that? A pointer would be fine. I'm
> wondering what the role of Endo is here.
I don't know if there's anything written about it.
Essentially, "Cont (Endo b) a" is isomorphic to "(a -> b -> b) -> b ->
b", which is (one implementation of) a backtracking monad. The use of
Endo b introduces the failure continuation.
newtype Nondet a = Nondet { runNondet :: forall b. (a -> b -> b) -> b -> b) }
toNondet :: (forall b. Cont (Endo b) a) -> Nondet a
toNondet m = Nondet (\sk fk -> appEndo (runCont m (Endo . sk)) fk)
fromNondet :: Nondet a -> Cont (Endo b) a
fromNondet m = Cont $ \sk -> Endo $ \fk -> runNondet m (appEndo . sk) fk
The Monad and MonadPlus instances you would write for Nondet are
equivalent to the instances for Cont (Endo b).
instance Monad Nondet where
return a = Nondet (\k -> k a)
m >>= f = Nondet (\k -> runNondet m (\a -> runNondet (f a) k))
instance MonadPlus Nondet where
mzero = Nondet (\k -> id)
mplus a b = Nondet (\k -> runNondet a k . runNondet b k)
Note that id and (.) are the mempty and mappend for Endo.
Interestingly, the backtracking monad transformer NondetT m a is
equivalent to "forall b. Cont (Endo (m b)) a", not "ContT (Endo b) m
a".
newtype NondetT m a = NondetT { runNondetT :: forall b. (a -> m b -> m
b) -> m b -> m b }
toNondetT :: (forall b. Cont (Endo (m b)) a) -> NondetT m a
toNondetT m = NondetT (\sk fk -> appEndo (runCont m (Endo . sk)) fk)
fromNondetT :: NondetT m a -> Cont (Endo (m b)) a
fromNondetT m = Cont $ \sk -> Endo $ \fk -> runNondetT m (appEndo . sk) fk
Here's the lift for NondetT, after conversion:
lift' :: Monad m => m a -> Cont (Endo (m b)) a
lift' m = Cont $ \sk -> Endo $ \fk -> m >>= \a -> appEndo (sk a) fk
More information about the Libraries
mailing list