[Haskell-cafe] Re: Mysterious fact
Ertugrul Soeylemez
es at ertes.de
Mon Nov 8 18:12:35 EST 2010
Andrew Coppin <andrewcoppin at btinternet.com> wrote:
> The other day, I accidentally came up with this:
>
> |{-# LANGUAGE RankNTypes #-}
>
> type Either x y= forall r. (x -> r) -> (y -> r) -> r
>
> left :: x -> Either x y
> left x f g= f x
>
> right :: y -> Either x y
> right y f g= g y
>
> This is one example; it seems that just about any algebraic type can
> be encoded this way. I presume that somebody else has thought of this
> before. Does it have a name?
You may want to have a look at my contstuff library, which implements
all the usual monads in CPS:
http://hackage.haskell.org/package/contstuff
This is just the style you implemented Either in, but slightly more
general and with an explicit result type parameter:
newtype EitherT r e m a =
EitherT {
getEitherT :: (a -> m r) -> (e -> m r) -> m r
}
Greets,
Ertugrul
--
nightmare = unsafePerformIO (getWrongWife >>= sex)
http://ertes.de/
More information about the Haskell-Cafe
mailing list