Functional Programming
10. Continuations continued




10.1 call/cc and support for Continuations

If a continuation is the future execution of an expression, then invoking the continuation interferes with the usual call/return behaviour of expression evaluation. So some kind of continuation mechanism needs to be part of the language. Scheme introduced the call/cc construct.

If a function f is being evaluated on arguments args inside a complex expression, as in ( ... (f args) ... ) Then the continuation of (f args) can be expressed as a lambda term like this

(define cc (lambda (f-result) ( ... f-result ... ) ) )

where f-result is in the same position as (f args) was in the original expression. Then the original expression is equivalent to (cc (f args))

Now thinking of cc as the future of the computation after (f args) completes, we could pass that future directly to f as an additional argument k. When f is finished, it invokes k on the value that (f args) computed, doing something like this ( (lambda (args k) (k (f args))) cc )

But where do we obtain the actual continuation to supply? This is what call/cc does. ( ... (call/cc fc) ... ) bundles up the future evaluation around the call/cc into a continuation that is passed as a parameter to fc.

For example
(call/cc (lambda (k) (k 42)))
returns 42 as the value of the call/cc. While
(+ 1 2 (call/cc (lambda (k) (k 42))))
returns 42 into the middle of the + expression, and results in 45 as the value of the full expression.

We can explicitly define a function expecting a continuation function (define (h k) (k '(42 45))) and then use it, for example, like this (first (call/cc h))

Now, call/cc assumes that the function it is invoking accepts exactly one parameter, namely the continuation. So if you need to pass additional parameters, you need to wrap them up first by building a closure to pass into the call/cc. For example the call/cc form of the f in this (+ 42 (f 3 4)) would be (+ 42 (call/cc (lambda(k) (k (f 3 4))) ) )

10.2 Breaking and Resuming



So far we have done nothing very interesting. But a continuation captures a point in the evaluation of an expression, so we can interrupt an evaluation and get the equivalent of a break statement for an imperative block.

code/Continuations1/CC-2.rkt

    #lang racket
     
    ; break will be bound to the continuation of the read-eval-print loop
     
    (call/cc (lambda (break)
        (print "hello")(newline)
        (break "I'm outta here")  ; continue with the original context
        (print "world")(newline)
        ))
     
    ; the break arrives here with the value of "I'm outta here" 
    ; as the result from the call/cc


A continuation can be used to capture a point in an evaluation for later resumption. You can even keep local state inside the function being resumed. The variable i is local to the outer lambda, and keeps its state over multiple resumptions. It is re-invoked in the middle of the evaluation. Note how the continuation captures control flow, but the global state changes between invocations of the continuation.

code/Continuations1/CC-6.rkt

    #lang racket
    (define resume-test-3 #f)
     
    (define test-3 (lambda ()
       ; the let defines a variable i local to the lambda, and 
       ; sets its value to 0
       (let ((i 0))
         ;
         (call/cc (lambda (k) (set! resume-test-3 k)))
         ;
         ; The next time the-continuation is called, we start here.
         (displayln "I am back ")
         (set! i (+ i 1))
         ; and return the value i
         i
         )
        ))
     
    (test-3)
    (resume-test-3)
    (resume-test-3)






10.3 Tree Traversal With Error Bailout

Here is an expression evaluator over expression trees. The continuations are used to handle exceptional conditions like a potential divide by zero.

code/Continuations1/Evaluate.rkt

    #lang racket
     
    ; tree abstract data type
    ; a leaf is a single element list with Content
    ; a branch is a 3 element list with Content, Left, and Right
     
    (define Content (lambda (tree) (first tree)))
    (define Left (lambda (tree) (second tree)))
    (define Right (lambda (tree) (third tree)))
     
    (define AtLeaf? (lambda (tree) (null? (rest tree))))
    (define At+? (lambda (tree) (eq? (Content tree) '+)))
    (define At*? (lambda (tree) (eq? (Content tree) '*)))
    (define At-? (lambda (tree) (eq? (Content tree) '-)))
    (define At/? (lambda (tree) (eq? (Content tree) '/)))
     
    ; evaluate the expression, but do bogus things with bad situations
    ; we should bailout to the caller when we cannot proceed to compute
     
    (define ArithEvalV1
      (lambda (tree)
        (if (AtLeaf? tree) (Content tree)
            (let ( 
                  (lval (ArithEvalV1 (Left tree)))
                  (rval (ArithEvalV1 (Right tree)))
                  )
            (cond 
              ( (At+? tree) (+ lval rval) )
              ( (At*? tree) (* lval rval) )
              ( (At-? tree) (- lval rval) )
              ( (At/? tree) (if (= rval 0) "Divide by 0" (/ lval rval) ) )
              ( #t (list "Unknown Operator" (Content tree)))
              )
            )))
      )
         
     
    (define t1 '(+ (1) (* (2)  (3) )))
    ;(ArithEvalV1 t1)
    (define t2 '(/ (10) (- (7) (+ (1) (* (2)  (3) )))))
    ;(ArithEvalV1 t2)
    (define t3 '(+ (1) (** (2)  (3) )))
    ;(ArithEvalV1 t3)
     
    ; ok, this is what we would like to do, passing in a routine that terminates
    ; and bailout to the caller returning an error value.
    (define ArithEvalV2
      (lambda (tree)
        
        (letrec
            ( (E (lambda (tree bailout)
                   (if (AtLeaf? tree) (Content tree)
                       (let ( 
                             (lval (E (Left tree) bailout))
                             (rval (E (Right tree) bailout))
                             )
                         (cond 
                           ( (At+? tree) (+ lval rval) )
                           ( (At*? tree) (* lval rval) )
                           ( (At-? tree) (- lval rval) )
                           ( (At/? tree) (if (= rval 0) (bailout "Divide by 0") (/ lval rval) ) )
                           ( #t (bailout (list "Unknown Operator" (Content tree))) )
                           )
                         )))
                 ))
          (E tree (lambda (x) (list "bailing out with" x)))
          )
        )
      )
     
    ;(ArithEvalV2 t1)
    ;(ArithEvalV2 t2)
    ;(ArithEvalV2 t3)
     
    (define ArithEvalV3
      (lambda (tree)
        ; this next operation calls the function with the current continuation
        ; so we can bailout and leap to the future with our return value.
        
        (call-with-current-continuation  ; see also let/cc
         (lambda (bailout) 
           (letrec
               ( (E (lambda (tree)
                      (if (AtLeaf? tree) (Content tree)
                          (let ( 
                                (lval (E (Left tree)))
                                (rval (E (Right tree)))
                                )
                            (cond 
                              ( (At+? tree) (+ lval rval) )
                              ( (At*? tree) (* lval rval) )
                              ( (At-? tree) (- lval rval) )
                              ( (At/? tree) (if (= rval 0) (bailout "Divide by 0") (/ lval rval) ) )
                              ( #t (bailout (list "Unknown Operator" (Content tree))) )
                              )
                            )))
                    ))
             (E tree)
             ) )                             )
        )
      )
     
    (ArithEvalV3 t1)
    (ArithEvalV3 t2)
    (ArithEvalV3 t3)
     
    (define ArithEvalV4
      (lambda (tree)
        ; an escape continuation is a more lightweight version of the current
        ; continuation, and only exists within the dynamic context of the 
        ; call-with-escape-continuation
        
        (call-with-escape-continuation  ; see also let/ec
         (lambda (bailout) 
           (letrec
               ( (E (lambda (tree)
                      (if (AtLeaf? tree) (Content tree)
                          (let ( 
                                (lval (E (Left tree)))
                                (rval (E (Right tree)))
                                )
                            (cond 
                              ( (At+? tree) (+ lval rval) )
                              ( (At*? tree) (* lval rval) )
                              ( (At-? tree) (- lval rval) )
                              ( (At/? tree) (if (= rval 0) (bailout "Divide by 0") (/ lval rval) ) )
                              ( #t (bailout (list "Unknown Operator" (Content tree))) )
                              )
                            )))
                    ))
             (E tree)
             ) )                             )
        )
      )
     
    ;(ArithEvalV4 t1)
    ;(ArithEvalV4 t2)
    ;(ArithEvalV4 t3)


10.4 Co-routines

Co-routines are functions that transfer control between each otehr, with control resuming after the point that control was transferred.

code/Continuations1/Coroutines.rkt

    #lang racket
     
    (define R1-c (lambda (arg) (display "Error R1-c not defined yet") ))
    (define R2-c (lambda (arg) (display "Error R2-c not defined yet") ))
     
    (define R1 
      (lambda ()
        (call/cc 
         (lambda (break) 
           (let ((i 5))
             ; capture our continuation, but bail out of further execution
             (call/cc (lambda (k) (set! R1-c k) (break "R1-c defined")))
             ;
             ; The next time the-continuation is called, we start here.
             (display "R1 - I am back ")
             ; we are mutating the state inside the continuation, so we get
             ; a new result everytime we invoke the continuation
             (set! i (- i 1))
             (display i) (newline)
             (if (> i 0) (R2-c 0) i)
             ) 
           )
         )
        ))
     
    (define R2 
      (lambda ()
        (call/cc 
         (lambda (break) 
           (let ((i 5))
             ; capture our continuation, but bail out of further execution
             (call/cc (lambda (k) (set! R2-c k) (break "R2-c defined")))
             ;
             ; The next time the-continuation is called, we start here.
             (display "R2 - I am back ")
             ; we are mutating the state inside the continuation, so we get
             ; a new result everytime we invoke the continuation
             (set! i (+ i 1))
             (display i) (newline)
             (R1-c 0)
             i)
           ) 
         )
        )
      )
     
    ; to start things off we need to
    (R1)
    (R2)
    (R1-c) ; or (R2-c) if you want R2 to go first


10.5 Exceptions With Continuations

Here is an example of exception handling using continuations. In the first case we just throw an exception. Note how the THROW continuation is invoked without a result.

code/TryCatch/try-catch-v0.rkt

    #lang racket
     
    ; pattern for
    ; TRY
    ; CATCH
    ; RESUME
     
    (define testit (lambda (x y default)
      
    ; RESUME                 
    (call/cc
     (lambda (RESUME)  ; when everything is finished we invoke RESUME
       
       (call/cc 
        (lambda (THROW)  ; the context around this is the catch
          ; TRY
          ; here is the body of the try, which computes result
          
          (let ((result
                 ; compute the result in here, or throw
                 (if (not (eq? 0 y)) (/ x y) (THROW))
                 ))
            
            ; it worked, so return result
            (RESUME result)
            )
          )
        )
       
       ; CATCH
       ; what happens here is the catch, invoked only if we throw
       ; in this case we return the default value
       (display "Caught exception")(newline)
     
       (RESUME default)
       )
     )
                     
    ))
     
    (testit 4 2 "div by 0")
    (testit 4 0 "div by 0")
     


In this version we throw an exception type which is caught by the catch code.

code/TryCatch/try-catch-v1.rkt

    #lang racket
     
    ; pattern for
    ; TRY
    ; CATCH
    ; RESUME
     
    (define testit (lambda (x y default)
      
    ; RESUME                 
    (call/cc
     (lambda (RESUME)  ; when everything is finished we invoke RESUME
       
       (let ( (exception 
               
               ; the context around this is the catch, it expects an exception result
               (call/cc 
                (lambda (THROW)  
                  ; TRY
                  ; here is the body of the try, which computes result
                  
                  (let ((result
                         ; compute the result in here, or throw
                         (if (not (eq? 0 y)) (/ x y) (THROW "DivBy0"))
                         ))
                    
                    ; it worked, so return result
                    (RESUME result)
                    )
                  )
                ) ) )
     
       
       ; CATCH
       ; what happens here is the catch, invoked only if we throw
       ; in this case we return the default value
       (display "Caught ")(display exception)(newline)
       (RESUME default)
     
       )
     )
                     
    )))
     
    (testit 4 2 "Arrgh, do not divide by 0")
    (testit 4 0 "Arrgh, do not divide by 0")


code/TryCatch/try-catch-v2.rkt

    #lang racket
     
    ; pattern for
    ; TRY
    ; CATCH
    ; RESUME
     
    (define testit 
      (lambda (x y default)
        
        ; RESUME                 
        (call/cc
         (lambda (RESUME)  ; when everything is finished we invoke RESUME
           
           (let ( 
                 (exception 
                  
                  ; the context around this is the catch, it expects an exception result
                  (call/cc 
                   (lambda (THROW)  
                     ; TRY
                     ; here is the body of the try, which computes result
                     
                     (let ((result
                            ; compute the result in here, or throw
                            (if (not (eq? 0 y)) (/ x y) (THROW "DivBy0"))
                            ))
                       
                       ; it worked, so return result
                       (if (eq? result 5) (THROW "My bad")
                           (RESUME result))
                       )
                     )
                   ) ) )
             
             
             ; CATCH
             ; what happens here is the catch, invoked only if we throw
             ; in this case we return the default value
             (display "Caught ")(display exception)(newline)
             (if (equal? exception "DivBy0") (RESUME default) (RESUME (list "Got" exception)))
             
             )
           )
         
         )))
     
    (testit 4 2 "Arrgh, do not divide by 0")
    (testit 4 0 "Arrgh, do not divide by 0")
    (testit 10 2 "Arrgh, do not divide by 0")


10.6 Unexpected Behaviour

In all of these examples, the behaviour when evaluating in the interaction window is different from what happens when you run the same commands as a program.

Well, actually this was true in previous versions of the IDE, but now seems to be fixed. What used to occur was that the continuation resumed inside the definitions window.

In this example, the program p1 sets up a continuation p1-c that enables the program to pause and then continue later after the pause.

code/CheckPoint/Checkpoint1.rkt

    #lang racket
     
    (define p1-c #f)
     
    (define p1
      (lambda ()
        (call/cc (lambda (yield) ; yield control and return to caller
        (let ( (x 0) )
          
          (set! x (+ x 1))
          (display x) (newline)
          
          ; the first checkpoint
          (call/cc (lambda (c)  (set! p1-c c) (yield x)))
                   
          (set! x (+ x 1))
          (display x) (newline)
     
          ; the second checkpoint
          (call/cc (lambda (c)  (set! p1-c c) (yield x)))
          
          ; there is no third checkpoint!
          (set! p1-c (lambda () "Hey, I'm finished"))
          
          "done"
          )))
        ))
     
    (p1)
     
    ; what happens if you uncomment this
    ; (p1-c)


In this version, p2 is a continuously running program that pauses inside the loop. Note the somewhat awkward definition of the loop in terms of the local recursive function p.

code/CheckPoint/Checkpoint2.rkt

    #lang racket
     
    (define p2-c #f)
    (define p2
      (lambda ()
        (call/cc (lambda (yield) 
        (letrec ( (x 0) 
          ; p is a continuously running program, that periodically yields and
          ; returns, but can be resumed by invoking continuation p2-c
          (p (lambda () (begin
               (set! x (+ x 1))
               (display x) (newline)
          
               (call/cc (lambda (c)  (set! p2-c c) (yield x)))
               
               (p)
               )))
          )
          ; start p
          (p)  
          ; we shoud never get here
          "p is done"
          )))
        ))
     
    (p2)
    ; what happens if you uncomment this
    ; (p2-c)


Continuations can interact with normal flow of control in surprising ways (at least initially). To explain what is happening in the following example when the last line is uncommented, think of what point p1 returns to in normal execution.

code/CheckPoint/Unexpected.rkt

    #lang racket
    (define x 0) ; shared state
     
    (define p1-c #f)
    (define p1
      (lambda ()
        ; set up a yield continuation
        (call/cc (lambda (yield) 
        (do () (#f) ; a do forever loop
               (set! x (+ x 1))
               (display x) (newline)
          
               (call/cc (lambda (c)  (set! p1-c c) (yield x)))
              
               )))
          )
        ; yield gets us here
    )
     
    ; define the checkpoint continuations
    (p1)
    ; what happens when we uncomment this
    ;(p1-c)
     


10.7 Simple Threads

As a final example, we implement a simple model of threads, using continuations to maintain the current state of each thread.

The idea is that there is a central thread scheduler which knows about every running thread. The scheduler can start a thread, but cannot interrupt a running thread. A running thread must call a yield function when it is ready to be interrupted. The yield function then returns to the scheduler, which will decide the next thread to execute. When a thread makes a normal return, it is finished, and removed from the collection of active threads.

The scheduler maintains a queue of active threads. When the current thread yields it is placed on the tail of the scheduling queue, and the thread at the head of the queue is removed and activated.

The threads package implements the following functions: Here are two examples of using the threads package.

code/Continuations1/ThreadExample1.rkt

    #lang racket
     
    (require "ThreadsV3.rkt")
     
    (define p1
      (lambda ()
     
        (display "p1: checkpoint 1")(newline)  (yield)
        (display "p1: checkpoint 2")(newline)  (yield)
        (display "p1: checkpoint 3")(newline)  (yield)
       
        (display "p1: finished")(newline)
        "p1: done"
        ))
     
    (define p2
      (lambda ()
     
        (display "p2: checkpoint 1")(newline)  (yield)
        (display "p2: checkpoint 2")(newline)  (yield)
        (display "p2: checkpoint 3")(newline)  (yield)
       
        (display "p2: finished")(newline)
        "p2: done"
        ))
     
    (scheduler-init)
    (create-thread p1)
    (create-thread p2)
    (scheduler-start)
     


code/Continuations1/ThreadExample2.rkt

    #lang racket
     
    (require "ThreadsV3.rkt")
     
    (define make-counter
      (lambda (init incr)
        (let ( (counter init) )
          (list 
           (lambda () counter) ; return the current value
           (lambda () (set! counter init) ) ; reset to the initial value
           (lambda () (set! counter (+ counter incr)) counter) ; increment and return the current value
           (lambda () (set! counter (- counter incr)) counter) ; decrement and return the current value
           ))))
     
    (define counter (make-counter 0 1))
    (define thread-num (first counter))
    (define thread-reset (second counter))
    (define ++thread-num (third counter))
    (define --thread-num (fourth counter))
     
    ; parallel search of a tree
     
    ; thread definer that returns a function that searches the current
    ; list for a target token.
    (define def-p
      (lambda (T token id)
        (lambda ()
          (display (list "thread " id " on " T " ")) 
          (newline)
          
          (if (list? T)
              (if (null? T) 
                  '()
                  
                  ; T is a list, spawn a thread for each element of list, then yield
                  (begin 
                    (map
                             (lambda (e) (create-thread (def-p e token (++thread-num) )) )
                             T
                             )
                         (yield)
                         )
                  )
              
              ; T is an atom, see if it matches token
              (begin
                ;(display (queue-get)) (display " ")
                (if (eq? T token) (display "match") (display "mismatch")) (newline)
                )
              )
          )
        )
      )
     
    (define tree 
      '( 1 2 1 ( 3 4 1 ( 2 1 ) 1 2 ) 4 (4 3 2 1 )))
     
    (scheduler-init)
    (thread-reset)
    (create-thread (def-p tree 1 (thread-num) ))
    (scheduler-start)


And here is the threads package. code/Continuations1/ThreadsV3.rkt

    #lang racket
     
    (provide scheduler-init)
    (provide scheduler-start)
    (provide create-thread)
    (provide yield)
     
     
    ; yield-cc is the continuation that returns to the scheduler and starts the next
    ; thread.  It's argument is used to control the behaviour of the scheduler.
     
    (define yield-cc #f)
     
    ; interface to the queue that is local to the scheduler. 
     
    (define queue-add #f)
    (define queue-head #f)
    (define queue-remove #f)
    (define queue-empty #f)
    (define queue-get #f)
     
    ; when the scheduler has no more threads to schedule, it invokes this continuation to
    ; return to the point after the scheduler-start invocation.  scheduler-start sets up
    ; this, so strange things will happen if scheduler-start isn't called.
     
    (define scheduler-return #f)  
     
    (define scheduler-init
      (lambda ()
        (call/cc 
         (lambda (return-from-init) 
           
           (let ( (queue '()) )
             (begin
               (set! queue-empty (lambda () (null? queue)))
               (set! queue-head (lambda () (first queue)))
               (set! queue-add (lambda (item) (set! queue (append queue (list item)))))
               (set! queue-remove (lambda () (let ( (head (first queue)) ) (set! queue (rest queue)) head)) )
               (set! queue-get (lambda () queue))
               
               ; define yield point
               (let ( 
                     (thread-cc
                      (call/cc (lambda (c) (set! yield-cc c) (return-from-init "scheduler-initialized") ) ) )
                     )
                 
                 ; yield returns to this point with the continuation for the thread just yielding
                 ; queue up this thread, if it returned a continuation, otherwise the thread is 
                 ; finished.
                 (if (continuation? thread-cc) (queue-add thread-cc) 
                     #f
                     ;(display (list "thread terminates with " thread-cc)) 
                     )
                 ;(display (list "thread yields" thread-cc queue) )(newline)
     
                 ; invoke new thread if any on queue
                 (if (queue-empty) 
                     (begin (display "scheduler done") (newline) (scheduler-return) ) 
                     ((queue-remove) #f)) 
                 )
               )))
         )))
     
    (define scheduler-start
      (lambda () (call/cc 
          (lambda (c) (set! scheduler-return c) (yield-cc #f)))
        ))
     
    ; we should also have a termination function that is called when the thread finally 
    ; completes (if ever)
     
    (define create-thread
      (lambda (p) (queue-add (lambda (c) (display (list "thread returns" (p) ) (yield-cc #f) ))) )
      )
     
    (define-syntax-rule (yield) 
      (call/cc (lambda (c) (yield-cc c)))
      )
     
}
10. Continuations continued
Notes on Functional Programming / Version 2.10 2014-02-24