Skip to content

Commit ae1c193

Browse files
reinerpreinerp
authored
Merge pull request #4 from awpr/master
Remove unneeded constraints on IxContT instances
2 parents 7f99697 + 3dce8b0 commit ae1c193

File tree

2 files changed

+146
-140
lines changed

2 files changed

+146
-140
lines changed

‎Control/Monad/Indexed/Cont.hs‎

Lines changed: 84 additions & 81 deletions
Original file line numberDiff line numberDiff line change
@@ -1,23 +1,26 @@
11
-------------------------------------------------------------------------------------------
22
-- |
3-
-- Module : Control.Monad.Indexed.Cont
4-
-- Copyright : 2008 Edward Kmett, Dan Doel
5-
-- License : BSD
3+
-- Module : Control.Monad.Indexed.Cont
4+
-- Copyright : 2008 Edward Kmett, Dan Doel
5+
-- License : BSD
66
--
7-
-- Maintainer : Reiner Pope <[email protected]>
8-
-- Stability : experimental
9-
-- Portability : rank-2 Types required for correctness of shift, but they can be removed
7+
-- Maintainer : Reiner Pope <[email protected]>
8+
-- Stability : experimental
9+
-- Portability : rank-2 Types required for correctness of shift, but they can be removed
1010
-------------------------------------------------------------------------------------------
11-
module Control.Monad.Indexed.Cont
12-
( IxMonadCont(reset, shift)
13-
, IxContT(IxContT, runIxContT)
14-
, runIxContT_
15-
, IxCont(IxCont)
16-
, runIxCont
17-
, runIxCont_
18-
) where
19-
11+
{-# LANGUAGE CPP #-}
12+
module Control.Monad.Indexed.Cont
13+
( IxMonadCont(reset, shift)
14+
, IxContT(IxContT, runIxContT)
15+
, runIxContT_
16+
, IxCont(IxCont)
17+
, runIxCont
18+
, runIxCont_
19+
) where
20+
21+
#if __GLASGOW_HASKELL__ < 709
2022
import Control.Applicative
23+
#endif
2124
import Data.Pointed
2225
import qualified Control.Monad.Cont as Cont
2326
import Control.Monad.Identity
@@ -27,110 +30,110 @@ import Control.Monad.Reader
2730
import Control.Monad.Indexed.Trans
2831

2932
class IxMonad m => IxMonadCont m where
30-
reset :: m a o o -> m r r a
31-
shift :: ((forall i. a -> m i i o) -> m r j j) -> m r o a
32-
-- shift :: ((a -> m i i o) -> m r j j) -> m r o a
33+
reset :: m a o o -> m r r a
34+
shift :: ((forall i. a -> m i i o) -> m r j j) -> m r o a
35+
-- shift :: ((a -> m i i o) -> m r j j) -> m r o a
3336

3437
newtype IxContT m r o a = IxContT { runIxContT :: (a -> m o) -> m r }
3538

36-
runIxContT_ :: Monad m => IxContT m r a a -> m r
39+
runIxContT_ :: Monad m => IxContT m r a a -> m r
3740
runIxContT_ m = runIxContT m return
3841

3942
instance IxFunctor (IxContT m) where
40-
imap f m = IxContT $ \c -> runIxContT m (c . f)
43+
imap f m = IxContT $ \c -> runIxContT m (c . f)
4144

4245
instance IxPointed (IxContT m) where
43-
ireturn a = IxContT ($a)
46+
ireturn a = IxContT ($a)
4447

45-
instance Monad m => IxApplicative (IxContT m) where
46-
iap = iapIxMonad
48+
instance IxApplicative (IxContT m) where
49+
iap = iapIxMonad
4750

48-
instance Monad m => IxMonad (IxContT m) where
49-
ibind f c = IxContT $ \k -> runIxContT c $ \a -> runIxContT (f a) k
51+
instance IxMonad (IxContT m) where
52+
ibind f c = IxContT $ \k -> runIxContT c $ \a -> runIxContT (f a) k
5053

5154
instance Monad m => IxMonadCont (IxContT m) where
52-
reset e = IxContT $ \k -> runIxContT e return >>= k
53-
shift e = IxContT $ \k -> e (\a -> IxContT (\k' -> k a >>= k')) `runIxContT` return
55+
reset e = IxContT $ \k -> runIxContT e return >>= k
56+
shift e = IxContT $ \k -> e (\a -> IxContT (\k' -> k a >>= k')) `runIxContT` return
5457

5558
callCC :: Monad m => ((forall i b. a -> IxContT m o i b) -> IxContT m r o a) -> IxContT m r o a
5659
callCC f = shift (\k -> f (adapt k) >>>= k)
57-
where
58-
-- Both 'shift' and 'callCC' capture the current continuation up to the
59-
-- containing 'reset'; but where 'shift' continuations "return" the
60-
-- value "return"ed by the containing 'reset'-delimited computation,
61-
-- 'callCC' continuations never "return" but instead cause the
62-
-- containing 'reset' to "return" the captured continuation's result.
63-
--
64-
-- @adapt k x@ converts a 'shift'-style continuation to a
65-
-- 'callCC'-style continuation by using its "return"ed value directly
66-
-- as the final result.
67-
--
68-
-- @escape x@ ignores its continuation and provides x directly as the
69-
-- result.
70-
adapt k x = k x >>>= escape
71-
escape x = IxContT (\_k -> return x)
72-
73-
instance Monad m => Functor (IxContT m i j) where
74-
fmap = imap
75-
76-
instance Monad m => Pointed (IxContT m i i) where
77-
point = ireturn
78-
79-
instance Monad m => Applicative (IxContT m i i) where
80-
pure = ireturn
81-
(<*>) = iap
82-
83-
instance Monad m => Monad (IxContT m i i) where
84-
return = ireturn
85-
m >>= k = ibind k m
86-
87-
instance Monad m => Cont.MonadCont (IxContT m i i) where
88-
-- GHC < 7.10 needs some hand-holding to specialize the 'forall' in the
89-
-- continuation type. Otherwise we'd just have:
90-
-- callCC = callCC
91-
callCC f = callCC (\k -> f k)
60+
where
61+
-- Both 'shift' and 'callCC' capture the current continuation up to the
62+
-- containing 'reset'; but where 'shift' continuations "return" the
63+
-- value "return"ed by the containing 'reset'-delimited computation,
64+
-- 'callCC' continuations never "return" but instead cause the
65+
-- containing 'reset' to "return" the captured continuation's result.
66+
--
67+
-- @adapt k x@ converts a 'shift'-style continuation to a
68+
-- 'callCC'-style continuation by using its "return"ed value directly
69+
-- as the final result.
70+
--
71+
-- @escape x@ ignores its continuation and provides x directly as the
72+
-- result.
73+
adapt k x = k x >>>= escape
74+
escape x = IxContT (\_k -> return x)
75+
76+
instance Functor (IxContT m i j) where
77+
fmap = imap
78+
79+
instance Pointed (IxContT m i i) where
80+
point = ireturn
81+
82+
instance Applicative (IxContT m i i) where
83+
pure = ireturn
84+
(<*>) = iap
85+
86+
instance Monad (IxContT m i i) where
87+
return = ireturn
88+
m >>= k = ibind k m
89+
90+
instance Monad m => Cont.MonadCont (IxContT m i i) where
91+
-- GHC < 7.10 needs some hand-holding to specialize the 'forall' in the
92+
-- continuation type. Otherwise we'd just have:
93+
-- callCC = callCC
94+
callCC f = callCC (\k -> f k)
9295

9396
instance IxMonadTrans IxContT where
94-
ilift m = IxContT (m >>=)
97+
ilift m = IxContT (m >>=)
9598

9699
instance MonadReader e m => MonadReader e (IxContT m i i) where
97-
ask = ilift ask
98-
local f m = IxContT $ \c -> do
99-
r <- ask
100-
local f (runIxContT m (local (const r) . c))
100+
ask = ilift ask
101+
local f m = IxContT $ \c -> do
102+
r <- ask
103+
local f (runIxContT m (local (const r) . c))
101104

102105
instance MonadState e m => MonadState e (IxContT m i i) where
103-
get = ilift get
104-
put = ilift . put
106+
get = ilift get
107+
put = ilift . put
105108

106109
instance MonadIO m => MonadIO (IxContT m i i) where
107-
liftIO = ilift . liftIO
110+
liftIO = ilift . liftIO
108111

109-
newtype IxCont r o a = IxCont (IxContT Identity r o a)
110-
deriving (IxFunctor, IxPointed, IxApplicative, IxMonad, IxMonadCont)
112+
newtype IxCont r o a = IxCont (IxContT Identity r o a)
113+
deriving (IxFunctor, IxPointed, IxApplicative, IxMonad, IxMonadCont)
111114

112115

113-
runIxCont :: IxCont r o a -> (a -> o) -> r
116+
runIxCont :: IxCont r o a -> (a -> o) -> r
114117
runIxCont (IxCont k) f = runIdentity $ runIxContT k (return . f)
115118

116119
runIxCont_ :: IxCont r a a -> r
117120
runIxCont_ m = runIxCont m id
118121

119122
instance Cont.MonadCont (IxCont i i) where
120-
callCC f = IxCont (callCC (\q -> unwrapIxCont (f (IxCont . q))))
121-
where unwrapIxCont (IxCont x) = x
123+
callCC f = IxCont (callCC (\q -> unwrapIxCont (f (IxCont . q))))
124+
where unwrapIxCont (IxCont x) = x
122125

123126
instance Functor (IxCont i j) where
124-
fmap = imap
127+
fmap = imap
125128

126129
instance Pointed (IxCont i i) where
127-
point = ireturn
130+
point = ireturn
128131

129132
instance Applicative (IxCont i i) where
130-
pure = ireturn
131-
(<*>) = iap
133+
pure = ireturn
134+
(<*>) = iap
132135

133136
instance Monad (IxCont i i) where
134-
return = ireturn
135-
m >>= k = ibind k m
137+
return = ireturn
138+
m >>= k = ibind k m
136139

0 commit comments

Comments
 (0)