4

The following is a simple example of using delimited continuation (reset/shift):

import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Cont

test :: Integer
test = evalCont . reset $ do
    r <- shift $ \k -> do
        return $ k 10
    return $ 1 + r

λ> test1
11

It works well.

However, I'd like to extract the continuation k as a pure function for future use, instead of just calling it inside shift.

For example, I hope the test2 could return the k:

test2 :: Integer -> Integer
test2 = evalCont . reset $ do
    r <- shift $ \k -> do
        return $ k
    return $ 1 + r

but GHC complains:

    ? Couldn't match type 'Integer -> Integer' with 'Integer'
      Expected type: Cont (Integer -> Integer) (Integer -> Integer)
        Actual type: ContT
                       (Integer -> Integer)
                       Data.Functor.Identity.Identity
                       ((Integer -> Integer) -> Integer -> Integer)
    ? In a stmt of a 'do' block: return $ k
      In the expression: do return $ k
      In the second argument of '($)', namely '\ k -> do return $ k'
   |
88 |         return $ k
   |         ^^^^^^^^^^

Anyone could help me to work around this problem?

Thanks.

chansey
  • 1,266
  • 9
  • 20
  • 2
    `r` is supposed to be the `Int -> Int` continuation, right? So you can’t add 1 to it in the last line of `test2` – Benjamin Hodgson Jul 01 '22 at 23:19
  • @BenjaminHodgson You are right. There is indeed a type mismatch (since Haskell is a static type language). I have added a temporary solution. Correct me if I am wrong, thanks. – chansey Jul 02 '22 at 01:42

2 Answers2

3

The standard Cont is incompletely general. "Real" Cont looks like this

newtype Cont    i o a =    Cont { runCont :: (a -> i) -> o }
-- versus the standard
newtype SadCont   r a = SadCont { sadCont :: (a -> r) -> r }
-- SadCont r a = Cont r r a

The standard SadCont is used because it supports >>= and return at their usual types (so it can be a Monad). But "real" delimited continuations inside Cont allow each shift to take values from the continuation at one type and send them up towards the previous shift/reset at a different type. In this case you are just passing the entire continuation as a function from shift to reset.

{-# LANGUAGE RebindableSyntax #-}
-- ^ placing this at the top of a file or passing -XRebindableSyntax to GHC allows do notation to use custom (>>=) and (>>)

-- not Monad operations!
return :: a -> Cont r r a
return x = Cont ($ x)
(>>=) :: Cont m o a -> (a -> Cont i m b) -> Cont i o b
Cont x >>= f = Cont $ \k -> x (($ k) . runCont . f)
(>>) :: Cont m o a -> Cont i m b -> Cont i o b -- RebindableSyntax also wants this
a >> b = a >>= const b

evalCont :: Cont a o a -> o
evalCont (Cont x) = x id

-- shift/reset are actually just
reset = evalCont
shift = Cont
-- note that the types of reset and shift differ significantly from transformers
-- reset returns a pure value here and shift requires a pure value from its function
-- I think my choices are more correct/standard, e.g. they line up with the old Scala shift/reset http://lampwww.epfl.ch/~hmiller/scaladoc/library/scala/util/continuations/package.html

In your example

test2 :: Integer -> Integer
test2 = reset $ do
    r <- shift $ \k -> k
    return $ 1 + r

TL;DR Cont is deliberately "broken", so it loses the generality of differing input and output types but gains Monadicity. You can hack around it by putting the input and output types into a (recursive) sum as you've discovered. Alternatively (this answer) you can define and use "real" Cont.

HTNW
  • 27,182
  • 1
  • 32
  • 60
  • About `shift = Cont`, but why not define `shift f = Cont $ \k -> runCont (f k) id` ? `shift` should support nesting. For example, in Racket `(reset (+ 1 (shift k1 (+ 3 (shift k2 (+ 100 (k2 50))) )) 1000))` returns `153`. – chansey Jul 02 '22 at 19:08
  • If `shift = Cont`, you cannot call `shift` inside `shift`. I have improved your `shift` to support nesting: `test3 :: Integer test3 = reset $ do r <- shift $ \k1 -> do r2 <- shift $ \k2 -> return $ 100 + (k2 50) return $ 3 + r2 return $ 1 + r + 1000`. Now the `test3` could return `153` too. – chansey Jul 02 '22 at 19:09
  • For `Cont i o a`, I think you are right. I have upvoted this answer. The `Cont i o a` is indeed better than `Cont r a`. However, if considering Monads' composition (e.g. composing State monad), we might still rollback to the old transformer version with the recursive sum. – chansey Jul 02 '22 at 19:09
  • BTW, I just found another delimited continuation library `Control.Monad.CC`, I have not tried it though. – chansey Jul 02 '22 at 19:11
  • 1
    @chansey My `shift` matches the one in the linked scala continuations library, and you can just `reset` inside `shift` (`shift $ \k -> reset $ _etc`) if you want nesting with it, so I elected *not* to force nesting into it (i.e. my `shift` is the "smallest" `shift`; nesting `shift`s is not fundamental to what `shift` does so it doesn't "belong") – HTNW Jul 02 '22 at 19:17
  • I see :). My improvement is just to follow the original semantics of reset/shift. – chansey Jul 02 '22 at 19:24
1

Inspired by @BenjaminHodgson's comment, here is the temporary solution:

data Ret a = Fun (Integer -> Ret a) | Val a

instance Show a => Show (Ret a) where
    show (Fun f) = "Jst f"
    show (Val a) = show a

test2 :: Ret Integer
test2 = evalCont . reset $ do
    r <- shift $ \k -> do
         return $ Fun k
    return $ Val (1 + r)

main :: IO ()
main = do
        print $ case test2 of (Fun f) -> f 100
        print $ case test2 of (Fun f) -> f 50

λ> main
101
51

Disclaimer: I'm not sure the recursive type Ret is necessary.

I will appreciate if someone could provide a better solution or explanation. Thanks.

chansey
  • 1,266
  • 9
  • 20