Skip to content

@DarkOtter /ShiftReturn.hs
Created

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
{-# 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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.