callCC in Haskell

Intro

Continuation passing style is a very interesting programming concept. In Haskell we have the continuation monad ContT, implemented in the transformers package. An introduction to the topic can be found in the open Haskell wiki book and Gabriel Gonzalez wrote a very nice article about why continuation passing style matters.

The wiki book article also mentions the callCC function. I think in general the explanation and motivation for this function is conveyed well in this article and the article is also not short on examples. The only thing I’m missing in it is an example of a full evaluation involving callCC. I think once you see how the function actually works things become much clearer. That will be the goal of this article. I won’t give any extra explanations, instead I will take one of the examples from the article and do a full evaluation of it.

callCC in action

Note: I will use the definitions from the transformers package, not from the wiki book article.

Here is the full example we will evaluate:

import Control.Monad.Cont
import Control.Monad.Cont.Class

bar :: String -> Cont r String
bar s = do
    msg <- callCC $ \k -> do
        when (s == "hello") $ k "They say hello."
        return ("They appear to be saying " ++ (show s))
    return msg

main :: IO ()
main = do
  let msg1 = runCont (bar "hello") id
  putStrLn ("msg1: " ++ msg1)
  let msg2 = runCont (bar "other") id
  putStrLn ("msg2: " ++ msg2)

We will transform the bar computation. Desugaring the outer do-notation yields

bar :: String -> Cont r String
bar s = check >>= ret
  where
    check = callCC (\k -> do
      when (s == "hello") $ k "They say hello."
      return ("They appear to be saying " ++ (show s)))
    ret = \msg -> return msg

Using the definition of the ContT monad’s bind (>>=) function and giving the anonymous function to callCC a name yields

bar :: String -> Cont r String
bar s = ContT $ \c1 -> runContT check (\x -> runContT (ret x) c1)
  where
    check = callCC f
    f k = do
      when (s == "hello") $ k "They say hello."
      return ("They appear to be saying " ++ (show s))
    ret = \msg -> return msg

Now we use the definition of callCC

bar :: String -> Cont r String
bar s = ContT $ \c1 -> runContT check (\x -> runContT (ret x) c1)
  where
    check = ContT $ \c2 -> runContT (f (\x -> ContT $ \ _ -> c2 x)) c2
    f k = do
      when (s == "hello") $ k "They say hello."
      return ("They appear to be saying " ++ (show s))
    ret = \msg -> return msg

Now we can also desugar the inner do computation, which yields

bar :: String -> Cont r String
bar s = ContT $ \c1 -> runContT check (\x -> runContT (ret x) c1)
  where
    check = ContT $ \c2 -> runContT (f (\x -> ContT $ \ _ -> c2 x)) c2
    f k = (when_f k) >>= ret_f
    when_f k = when (s == "hello") $ k "They say hello."
    ret_f = \_ -> return ("They appear to be saying " ++ (show s))
    ret = \msg -> return msg

Now we can fill in the definition of check, unpack the delayed continuation with runContT and then apply the continuation to it

bar :: String -> Cont r String
bar s = ContT $ \c1 -> runContT (f (\x -> ContT $ \_ -> (\x -> runContT (ret x) c1) x)) (\x -> runContT (ret x) c1)
  where
    f k = (when_f k) >>= ret_f
    when_f k = when (s == "hello") $ k "They say hello."
    ret_f = \_ -> return ("They appear to be saying " ++ (show s))
    ret = \msg -> return msg

Now we can substitute f by its definition and write the lengthy line in several lines

bar :: String -> Cont r String
bar s = ContT $ \c1 -> runContT (
    when_f (\x -> ContT $ \_ -> (\x -> runContT (ret x) c1) x) >>= ret_f
    ) (\x -> runContT (ret x) c1)
  where
    when_f k = when (s == "hello") $ k "They say hello."
    ret_f = \_ -> return ("They appear to be saying " ++ (show s))
    ret = \msg -> return msg

Once again using the definition ContT monad’s bind (>>=) function we end up with

bar :: String -> Cont r String
bar s = ContT $ \c1 -> runContT (
    ContT $ \c -> runContT (
      when_f (\x -> ContT $ \_ -> (\x -> runContT (ret x) c1) x)
      ) (\x -> runContT (ret_f x) c)
    ) (\x -> runContT (ret x) c1)
  where
    when_f k = when (s == "hello") $ k "They say hello."
    ret_f = \_ -> return ("They appear to be saying " ++ (show s))
    ret = \msg -> return msg

Unwrapping the inner runContT ContT ... layer and substituting for when_f yields

bar :: String -> Cont r String
bar s = ContT $ \c1 -> runContT (
      when (s == "hello") (ContT $ \_ -> (\x -> runContT (ret x) c1) "They say hello.")
      ) (\x -> runContT (ret_f x) (\x -> runContT (ret x) c1))
  where
    ret_f = \_ -> return ("They appear to be saying " ++ (show s))
    ret = \msg -> return msg

Now we are able to discuss the possible outcomes of the computation.

Calling bar with ‘hello’

Let’s assume we call bar with the string ‘hello’. In this case the predicate function of when returns True and when will simply evaluate to its second argument and we end up with

bar' :: Cont r String
bar' = ContT $ \c1 -> runContT (
      ContT $ \_ -> (\x -> runContT (ret x) c1) "They say hello."
      ) (\x -> runContT (ret_f x) (\x -> runContT (ret x) c1))
  where
    ret_f = \_ -> return ("They appear to be saying " ++ (show "hello"))
    ret = \msg -> return msg

Which we can simplify to

bar' :: Cont r String
bar' = ContT $ \c1 -> (\_ -> (\x -> runContT (ret x) c1) "They say hello."
      ) (\x -> runContT (ret_f x) (\x -> runContT (ret x) c1))
  where
    ret_f = \_ -> return ("They appear to be saying " ++ (show "hello"))
    ret = \msg -> return msg

If we cheat a bit we can rewrite it a bit further. The following won’t compile, because we are using variables out of scope, but it helps to see things a bit better

bar' :: Cont r String
bar' = ContT $ \c1 -> f k
  where
    f = (\_ -> (\x -> runContT (ret x) c1) "They say hello.")
    k = \x -> runContT (ret_f x) (\x -> runContT (ret x) c1)
    ret_f = \_ -> return ("They appear to be saying " ++ (show "hello"))
    ret = \msg -> return msg

Now we can run the main function (again in a sort of pseudo code)

main :: IO ()
main = do
  let msg1 = runCont (bar') id
           = runCont (ContT $ \c1 -> f k) id
           = (\c1 -> f k) id
           = ((\x -> runContT (ret x) id) "They say hello.")
           = runContT (ret "They say hello.") id
           = runContT (return "They say hello.") id
           = runContT (ContT ($ "They say hello.")) id
           = ($ "They say hello.") id
           = id "They say hello."
           = "They say hello."
  putStrLn ("msg1: " ++ msg1)

They key point to note here is that f ignored its argument, thus it was completely irrelevant what the actual value of k was. That is exactly the “early return” behavior that callCC aims to provide. If you look way to the beginning of the code transformation process you’ll notice that the definition of f came from the application of callCC.

Calling bar with ‘other’

Let’s now assume we call bar with the string ‘other’. In this case the predicate function of when returns False and when will simply evaluate to pure (), which in the case of the continuation monad equals ContT ($ ()).

bar' :: Cont r String
bar' = ContT $ \c1 -> runContT (ContT ($ ())) (\x -> runContT (ret_f x) (\x -> runContT (ret x) c1))
  where
    ret_f = \_ -> return ("They appear to be saying " ++ (show "other"))
    ret = \msg -> return msg

Which we can simplify to

bar' :: Cont r String
bar' = ContT $ \c1 -> runContT (ret_f ()) (\x -> runContT (ret x) c1)
  where
    ret_f = \_ -> return ("They appear to be saying " ++ (show "other"))
    ret = \msg -> return msg

And now the main function can be evaluated

bar' :: Cont r String
bar' = ContT $ \c1 -> runContT (ret_f ()) (\x -> runContT (ret x) c1)
  where
    ret_f = \_ -> return ("They appear to be saying " ++ (show "other"))
    ret = \msg -> return msg

main :: IO ()
main = do
  let msg2 = runCont bar2' id
           = runCont (ContT $ \c1 -> runContT (ret_f ()) (\x -> runContT (ret x) c1)) id
           = runContT (ret_f ()) (\x -> runContT (ret x) id)
           = runContT (return ("They appear to be saying " ++ (show "other"))) (\x -> runContT (ret x) id)
           = runContT (ContT ($ ("They appear to be saying " ++ (show "other")))) (\x -> runContT (ret x) id)
           = ($ ("They appear to be saying " ++ (show "other"))) (\x -> runContT (ret x) id)
           = (\x -> runContT (ret x) id) ("They appear to be saying " ++ (show "other"))
           = runContT (return "They appear to be saying \"other\"") id
           = "They appear to be saying \"other\""
  putStrLn ("msg2: " ++ msg2)

As can be seen we evaluated the inner compuatation of callCC’s argument to the end and did not make any use of the early return.

Key concept

It was probably not so easy to see the most key point in the above series of transformations, so I want to take the chance to show it once more. The argument to the argument of callCC (k in our case) has the following signature

k :: a -> ContT r m b

So it takes a value of type a and returns a continuation monad transformer. In our case k had the following definition

k = (\x -> ContT $ \_ -> c1 x)

where c1 was the actual continuation passed to callCC and captured as a closure. Let’s now assume a is the type Int and that we have the following computation:

computation = do
    compA
    ret <- callCC $ \k -> do
        compB
        compC
        k 42
        -- everything below here will be 'c2'
        compD
        compE
    -- everything below here will be 'c1'
    more1
    more2

Then we can also write this like that

computation = do
    compA
    ret <- callCC $ \k -> do
        compB
        compC
        k 42 >>= (\n -> compF)
    -- everything below here will be 'c1'
    more1
    more2
  where
    -- This will be 'c2'
    compF = do
            compB
            compC

Using what we know about k we get

computation = do
    compA
    ret <- callCC $ \k -> do
        compB
        compC
        (ContT $ \_ -> c 42) >>= (\n -> compF)
    -- everything below here will be 'c1'
    more1
    more2
  where
    -- This will be 'c2'
    compF = do
            compB
            compC

Again using the definition of (>>=) we get

computation = do
    compA
    -- here c1 comes to life
    ret <- callCC $ \k -> do
        compB
        compC
        ContT $ \c2 -> runContT (ContT $ \_ -> c1 42) (\x -> runContT ((\n -> compF) x) c2)
    -- everything below here will be 'c1'
    more1
    more2
  where
    -- This will be 'c2'
    compF = do
            compB
            compC

I marked for which part in the code c1 and c2 pose the continuation. When we focus at the lengthy term in the middle we can see that it is equal to

ContT $ \c2 -> (\_ -> c1 42) (\x -> runContT ((\n -> compF) x) c2)
=
ContT $ \c2 -> c1 42

This shows that no matter what follows after a call to k will be ignored. No matter how many compX terms there are (they could be arbitrarily many) and however complex c2 actually is, we will use c1 as the continuation. And we’ve been given c1 by callCC. The nice thing is that laziness helps us to end up with efficient code, since we only evaluate terms once we need their result. Thus c2 in our example (i.e. do compB; compC) will never be evaluated because we never actually need it!