[Haskell-cafe] Partially-applied type synonyms?
Lyle Kopnicky
lists at qseep.net
Thu Sep 2 20:29:18 EDT 2004
Chung-chieh,
Well, I tried what you suggested, and it seems to work. Unfortunately,
it's not very useful. The point of creating MonadPCont, was, like
MonadCont or MonadState, to automatically provide features to a monad
built from a transformer, without having to redefine them. Since ContT
is the monad transformer, I want any monad created from it to
automatically support the MonadPCont operations. But they can't,
because I can't make ContT an instance of MonadPCont.
I can make FlipContT an instance of MonadPCont, but I can't make
FlipContT a monad transformer. So what you have to do is create your
layered monadwith ContT on top, and then apply the FlipCont constructor
to get a monad with the methods of MonadPCont. Now since FlipContT
isn't a monad transformer, you can't lift things into it. You can lift
them into ContT and then write a wrapper around that.
My point is that, unfortunately, I don't think it's very practical to
create this type class. I think the problem is that, although MonadCont
attempts to describe a monad as having certain operations, MonadPCont
attempts to describe a group of related monads as having certain
operations. They are related by being formed from the same type
constructor.
Here's the modified code:
module MonadPCont where
import Control.Monad
import Control.Monad.Cont
import Control.Monad.Trans
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.State
import Control.Monad.RWS
class (Monad (mc a), Monad (mc r)) => MonadPCont mc a r where
shift :: ((forall b. Monad (mc b) => a -> mc b r) -> mc r r) -> mc r a
reset :: mc a a -> mc r a
instance MonadPCont Cont a r where
shift f = Cont (\c -> runCont (f (\x -> Cont (\c' -> c' (c x)))) id)
reset m = Cont (\c -> c (runCont m id))
data FlipContT m r a = FlipContT { unFlipContT :: (ContT r m a)}
instance Monad m => Monad (FlipContT m r) where
return x = FlipContT $ return x
(FlipContT m') >>= f = FlipContT $ m' >>= (unFlipContT . f)
runFlipContT :: FlipContT m r a -> (a -> m r) -> m r
runFlipContT (FlipContT m) = runContT m
instance Monad m => MonadPCont (FlipContT m) a r where
shift f = FlipContT $ ContT $ \c ->
runFlipContT (f (\x -> FlipContT $ ContT $ \c' -> c x
>>= c'))
return
reset m = FlipContT $ ContT $ \c -> runFlipContT m return >>= c
- Lyle
Chung-chieh Shan wrote:
>On 2004-08-31T09:55:10-0700, Lyle Kopnicky wrote:
>
>
>>Sorry, I don't think I made myself clear. I'm not defining PI, it's the
>>standard type binding operator, like lambda is the variable binding
>>operator. Maybe I could write it as 'II' so it looks more like a
>>capital pi. It's not a feature of Haskell, but part of type theory
>>(dependent types). I was mixing and matching and making it look like
>>Haskell. So instead of 'PI r -> ContT r m', I could write 'flip ContT',
>>except that 'flip' needs to work on a type level instead of a value
>>level. Or I could write '(`ContT` m)', or 'ContT _ m', where the '_' is
>>a hole. Does this make sense now?
>>
>>
>
>Yes, it makes sense now. You need to define
>
> newtype FlipContT m r a = FlipContT (ContT r m a)
>
>or more generally,
>
> newtype Flip c (m :: * -> *) r a = Flip (c r m a)
>
>The rationale for disallowing matching partially-applied type synonyms
>is that higher-order unification is undecidable.
>
>See also:
>
>Neubauer, Matthias, and Peter Thiemann. 2002. Type classes with
>more higher-order polymorphism. In ICFP '02: Proceedings of the ACM
>international conference on functional programming. New York: ACM Press.
>http://www.informatik.uni-freiburg.de/~neubauer/papers/icfp02.pdf
>http://www.informatik.uni-freiburg.de/~neubauer/papers/icfp02.ps.gz
>
>
>
More information about the Haskell-Cafe
mailing list