public
Created

  • Download Gist
ShiftReturn.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56
{-# LANGUAGE RankNTypes #-}
 
newtype Cont r a = Cont { unCont :: (a -> r) -> r }
 
runCont :: (forall r. Cont r a) -> a
runCont (Cont c) = c id
{-# INLINEABLE runCont #-}
 
instance Monad (Cont r) where
return x = Cont $ \k -> k x
{-# INLINE return #-}
(>>=) (Cont x) f = Cont $ \k -> x (\x' -> unCont (f x') k)
{-# INLINEABLE (>>=) #-}
 
callCC :: ((forall b. a -> Cont r b) -> Cont r a) -> Cont r a
callCC f = Cont $ \k -> unCont (f (\a -> Cont $ const $ k a)) k
 
shift :: ((a -> r) -> Cont r r) -> Cont r a
shift f = Cont $ \k -> unCont (f k) id
 
reset :: Cont a a -> Cont r a
reset (Cont c) = Cont $ \k -> k (c id)
 
-- This cannot typecheck (infinite types):
--
-- reset (shift return >>= \x -> return (x + 1)) >>= \f -> return (f 0 + f 1)
 
newtype ContI i j a = ContI { unContI :: (a -> j) -> i }
 
runContI :: (forall r. ContI r r a) -> a
runContI (ContI c) = c id
 
returnI :: a -> ContI i i a
returnI x = ContI $ \k -> k x
{-# INLINE returnI #-}
 
bindI :: (a -> ContI j k b) -> ContI i j a -> ContI i k b
bindI f (ContI x) = ContI $ \k -> x (\x' -> unContI (f x') k)
{-# INLINEABLE bindI #-}
 
(>>=!) :: ContI i j a -> (a -> ContI j k b) -> ContI i k b
(>>=!) = flip bindI
{-# INLINE (>>=!) #-}
 
callCCI :: ((forall b u. a -> ContI j u b) -> ContI i j a) -> ContI i j a
callCCI f = ContI $ \k -> unContI (f (\a -> ContI $ const $ k a)) k
 
shiftI :: ((a -> j) -> ContI i u u) -> ContI i j a
shiftI f = ContI $ \k -> unContI (f k) id
 
resetI :: ContI i a a -> ContI j j i
resetI (ContI c) = ContI $ \k -> k (c id)
 
-- This will now typecheck:
--
-- resetI (shiftI returnI >>=! \x -> returnI (x + 1)) >>=! \f -> returnI (f 0 + f 1)

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.