First, call/cc is used to grab the current continuation k and assign it to the variable "halt". Next, suppose "a" is invoked as in for example ">(a 1)". Then we have a growing stack containing 1,2,3,4,... until 1000 is reached. Then (halt halt) is invoked - but halt is a continuation taking us back to the time and place when halt was first defined. The value returned by call/cc at that place is "halt" (the only argument in (halt halt)). Thus halt is given its old value in the define statement! This means we can do the same thing all over again! Computation stops because the very next thing to do is exit the define.
(define call/cc call-with-current-continuation)(define halt (call/cc (lambda (k) k)))
(define a (lambda (n) (if (= n 1000) (halt halt) (a (+ n 1)))))
Invoke as follows: ">(try 1000 1)". The "let" assigns the current continuation to back. Then "m" is incremented by 1. As long as m is not equal to n, its value is displayed and (back back) invokes the continuation causing the computation to return in time and place to the "let" when the call/cc was first invoked. Then the "set!" increments "m" and the process repeats until "m"="n". If the "set!" is replaced by a "let" then the number 2 always gets printed out reflecting the passage through time to "back".
(define try
(lambda (n m)
(let ((back (call/cc (lambda (k) k))))
(set! m (+ m 1))
(if (= m n)
m
(begin
(display m)(newline)
(back back))))))
Use this code as follows: ">(create)", ">(demand)", ">(demand)",... The values returned are integers which increase in value. The producer of these values is the procedure "addit" which calls itself recursively with no conventional stopping condition. Each time through, the value of its argument is increased by 1. We would never see this if it weren't for "step-and-swap" which gets in the way and momentarily stops the computation. Every time "step-and-swap" is invoked (it is a continuation) "addit" is allowed to go one extra iteration (it is tail-recursive). Here are the details. First, ">(create)" grabs a current continuation and saves it in the variable "cont", then "looper" is invoked. Looper invokes "(step-and-swap '())" which grabs its own continuation, saves the old continuation in "old", saves its own continuation in "cont" and invokes the "old" continuation. At this point the old continuation takes us back to the first invocation of "create" with value '(). Hence computation ends. Now invoke ">(demand)". This calls step-and-swap which grabs its own continuation, saves the old continuation of "cont" (the one going back to within "looper") in old and saves its new continuation in "cont". It then invokes "old" sending control back to looper. Looper calls "addit" with argument 1 and the infinite loop is started. I hope you can figure out the rest. If not...I can give you an article which contains a complete description.
(define cont '())(define step-and-swap (lambda (value) (call/cc (lambda (k) (let ((old cont)) (set! cont k) (old value))))))
(define addit (lambda (x) (step-and-swap x) (addit (+ x 1))))
(define looper (lambda () (step-and-swap '()) (addit 1)))
(define create (lambda () (call/cc (lambda (k) (set! cont k) (looper)))))
(define demand (lambda () (step-and-swap '())))
We try to perform the same trick as with setjmp and longjmp. This time it works because continuations are correctly implemented. I refer the interested student to the notes I emailed on setjmp and longjmp for a discussion of control flow - it is almost exactly the same (the difference is that f1 calls itself in the Scheme code whereas looping was within f1 in the "C" code. In case you haven't realized it, this is an elementary example of how call/cc can be used to implement co-routines (procedures which suspend themselves to call others which suspend themselves and so on). You can try this code by typing the following at the prompt: "(main)". The output shows the alternations between procedures f1 and f2.
(define env1 '()) (define env2 '())(define main (lambda () (if (call/cc (lambda (k) (set! env1 k) '())) (f1) (f2))))
(define f1 (lambda () (display 'in-f1) (newline) (if (not (call/cc (lambda (k) (set! env1 k) '()))) (env2 #t) (f1))))
(define f2 (lambda () (display 'in-f2) (newline) (if (not (call/cc (lambda (k) (set! env2 k) '()))) (env1 #t) (f2))))