[Haskell-cafe] Different choice operations in a continuation monad
Holger Siegel
holgersiegel74 at yahoo.de
Tue Jun 15 11:58:22 EDT 2010
Hi Sebastian,
Am 15.06.2010 um 17:06 schrieb Sebastian Fischer:
> Dear Café,
>
> `MonadPlus` instances are usually required to satisfy certain laws, among them the monad laws and monoid laws for `mzero` and `mplus`. Additionally one may require that (>>=f) is a monoid morphism, that is:
>
> mzero >>= f = mzero
> (a `mplus` b) >>= f = (a >>= f) `mplus` (b >>= f)
>
> The list monad satisfies these additional laws, the `Maybe`-Monad does not satisfy the second, distributive, law:
>
> ghci> (return False `mplus` return True) >>= guard :: [()]
> [()]
> ghci> (return False `mplus` return True) >>= guard :: Maybe ()
> Nothing
>
> Instead of the distributive law, the `Maybe` monad satisfies a different law:
>
> return x `mplus` a = return x
>
> that is, `return` annihilates the `Maybe`-Monad regarding `mplus`. This "cancellation law" is incompatible with the distributive law because (together with other laws) it implies that the result of the above example expression is `Nothing` whereas the distributive law implies that it is `Just ()`.
>
> We can lift the `Maybe` type into a continuation monad:
>
> > newtype CMaybe r a = CMaybe ((a -> Maybe r) -> Maybe r)
> >
> > instance Monad (CMaybe r) where
> > return x = CMaybe (\k -> k x)
> > CMaybe ca >>= f = CMaybe (\k -> ca (\x -> let CMaybe cb = f x in cb k))
> >
> > instance MonadPlus (CMaybe r) where
> > mzero = CMaybe (\_ -> mzero)
> > CMaybe ca `mplus` CMaybe cb = CMaybe (\k -> ca k `mplus` cb k)
>
> Unlike the `Maybe`-monad, the `CMaybe`-monad satisfies the distributive law, not the cancellation law.
>
> Can you define an associative operation
>
> orElse :: CMaybe r a -> CMaybe r a -> CMaybe r a
>
> with identity `mzero` that satisfies the cancellation law?
No, because that function would need to cancel values of type a, but the arguments of type (CMaybe r a) can
only compute values of type r. But you can define
orElse :: CMaybe a a -> CMaybe a a -> CMaybe r a
CMaybe ca `orElse` CMaybe cb = CMaybe (\k -> (ca return `mplus` cb return) >>= k)
More information about the Haskell-Cafe
mailing list