blog.poucet.org Rotating Header Image

November 24th, 2006:

Delimited continuations

Playing around with delimited continuations in scheme, I read on another blog that the implementation as by Filinski is buggy and that mzscheme does it much better.

To try it out, simply perform this in mzscheme:

(require (lib "control.ss"))
(define f
(let ((x 0))
(reset
(begin
(set! x (+ x 1))
(cons x (shift k k))))))

Calling this several times does not lead to the expected result:

(f 1) => (1 . 1)
(f 1) => (1 . 1)
(f 1) => (1 . 1)

One would expect that calling it more than once would lead to an increment in the counter, as the let variable is only performed once and as such should be inside the closure that reset returns. Observationally, I was expecting the code to behave like this

(define f
(let ((x 0))
(lambda (y)
(begin
(set! x (+ x 1))
(cons x y)))))

It seems that scheme48 displays the same behaviour:

,open escapes signals
,load /usr/lib/scheme48/misc/shift-reset.scm
...

Any comments regarding this would be more than welcome as I am currently stumped on why this does not increment. I guess the only way to really explore this is to do the full CPS transformation as originally introduced by Oliver Danvy and Andrzej Filinski in “Abstracting Control” from 1990, although I will refer to the version from Chung-chie Shan in “Shift to Control” from 2004 as I personally found it more legible (my background is EE, not CS). Because I can not use overlines in html, I will represent the CPS-version of something by making it bold. (Note that this is taken from the paper of Shan, in his figure 1)

1. x                 = (lambda (c) (c x))
2. (lambda (x) E) = (lambda (c) (c (lambda (x) E)))
3a. (E1 E2) = (lambda (c) (E1 (lambda (f) (E2 (lambda (x) ((f x) c))))))
3b. (E1 E2 E3) = (lambda (c) (E1 (lambda (f) (E2 (lambda (x) (E3 (lambda (y) ((f x y) c))))))))

4. (reset E) = (lambda (c) (c (E (lambda (v) v))))
5. (shift f E) = (lambda (c) (let ((f (lambda (x) (lambda (c2) (c2 (c x))))))
(E (lambda (v) v)))

Lastly, of course, one needs a way to sequence operations begin.

6. (begin E1 E2) = (lambda (c) (E1 (lambda (x) (E2 c))))
;Derived through:
(begin E1 E2)
Equivalent code => ((lambda (_) (E2)) E1)
Apply Rule 3a => (lambda (c) ((lambda (_) (E2))
(lambda (f) (E1 (lambda (x) ((f x) c))))))
Apply Rule 2 => (lambda (c) ((lambda (c2) (c2 (lambda (x) E2)))
(lambda (f) (E1 (lambda (x) ((f x) c))))))
Beta Reduction => (lambda (c) ((lambda (f) (E1 (lambda (x) ((f x) c))))
(lambda (_) E2)))
Beta Reduction => (lambda (c) (E1 (lambda (x) (((lambda (_) E2) x) c))))
Beta Reduction => (lambda (c) (E1 (lambda (x) (E2 c))))

Applying this to the function definition above:

(let ((x 0))
(reset
(begin
(set! x (+ x 1))
(cons x (shift k k)))))


Desugaring =>
((lambda (x)
(reset
(begin
(set! x (+ x 1))
(cons x (shift k k)))))
0)

Apply Rule 3a =>
(lambda (c) ((lambda (x) `
(reset
(begin
(set! x (+ x 1))
(cons x (shift k k)))))

(lambda (f) (0 (lambda (x) ((f x) c))))))
Apply Rule 1 =>
(lambda (c) ((lambda (x)
(reset
(begin
(set! x (+ x 1))
(cons x (shift k k)))))

(lambda (f) ((lambda (c2) (c2 0)) (lambda (x) ((f x) c))))))
Beta Reduction =>
(lambda (c) ((lambda (x)
(reset
(begin
(set! x (+ x 1))
(cons x (shift k k)))))

(lambda (f) ((f 0) c))))
Apply Rule 2 =>
(lambda (c) ((lambda (c2) (c2 (lambda (x) (reset
(begin
(set! x (+ x 1))
(cons x (shift k k))))
)))
(lambda (f) ((f 0) c))))
Beta Reduction =>
(lambda (c) ((lambda (f) ((f 0) c))
(lambda (x) (reset
(begin
(set! x (+ x 1))
(cons x (shift k k))))
)))

Apply Rule 4 =>
(lambda (c) ((lambda (f) ((f 0) c))
(lambda (x) (lambda (c2) (c2 ((begin
(set! x (+ x 1))
(cons x (shift k k)))

(lambda (v) v)))))))
Beta Reduction =>
(lambda (c) (((lambda (x) (lambda (c2) (c2 ((begin
(set! x (+ x 1))
(cons x (shift k k)))

(lambda (v) v)))))
0) c))
Resugaring =>
(lambda (c) ((let ((x 0))
(lambda (c2) (c2 ((begin
(set! x (+ x 1))
(cons x (shift k k)))

(lambda (v) v)))))
c))
Apply Rule 6 =>
(lambda (c) ((let ((x 0))
(lambda (c2) (c2 ((lambda (c3)
((set! x (+ x 1))
(lambda (_) ((cons x (shift k k)) c3))))
(lambda (v) v)))))
c))
Beta Reduction =>
(lambda (c) ((let ((x 0))
(lambda (c2) (c2 ((set! x (+ x 1))
(lambda (_) ((cons x (shift k k))
(lambda (v) v)))))))
c))
Apply Rule 3b =>
(lambda (c) ((let ((x 0))
(lambda (c2) (c2 ((set! x (+ x 1))
(lambda (_) ((lambda (c4)
(cons
(lambda (f)
(x
(lambda (y)
((shift k k)
(lambda (z) ((f y z) c4))))))))
(lambda (v) v)))))))
c))
Beta Reduction =>
(lambda (c) ((let ((x 0))
(lambda (c2) (c2 ((set! x (+ x 1))
(lambda (_)
(cons
(lambda (f)
(x
(lambda (y)
((shift k k)
(lambda (z) ((f y z) (lambda (v) v)))))))))))))
c))
Apply Rule 1 =>
(lambda (c) ((let ((x 0))
(lambda (c2) (c2 ((set! x (+ x 1))
(lambda (_)
((lambda (c5) (c5 cps-cons))
(lambda (f)
(x
(lambda (y)
((shift k k)
(lambda (z) ((f y z) (lambda (v) v))))))))
)))))
c))
Beta Reduction =>
(lambda (c) ((let ((x 0))
(lambda (c2) (c2 ((set! x (+ x 1))
(lambda (_)
((lambda (f)
(x
(lambda (y)
((shift k k)
(lambda (z) ((f y z) (lambda (v) v)))))))
cps-cons))))))
c))
Beta Reduction =>
(lambda (c) ((let ((x 0))
(lambda (c2) (c2 ((set! x (+ x 1))
(lambda (_)
(x
(lambda (y)
((shift k k)
(lambda (z) ((cps-cons y z) (lambda (v) v)))))))))))
c))
Apply Rule 1 =>
(lambda (c) ((let ((x 0))
(lambda (c2) (c2 ((set! x (+ x 1))
(lambda (_)
((lambda (c) (c x))
(lambda (y)
((shift k k)
(lambda (z) ((cps-cons y z) (lambda (v) v)))))))))))
c))
Beta Reduction =>
(lambda (c) ((let ((x 0))
(lambda (c2) (c2 ((set! x (+ x 1))
(lambda (_)
((lambda (y)
((shift k k)
(lambda (z) ((cps-cons y z) (lambda (v) v)))))
x))))))
c))
Beta Reduction =>
(lambda (c) ((let ((x 0))
(lambda (c2) (c2 ((set! x (+ x 1))
(lambda (_)
((shift k k)
(lambda (z) ((cps-cons x z) (lambda (v) v)))))))))
c))
Apply Rule 5 =>
(lambda (c) ((let ((x 0))
(lambda (c2) (c2 ((set! x (+ x 1))
(lambda (_)
((lambda (c6) (let ((f (lambda (w) (lambda (c7) (c7 (c6 w))))))
(f (lambda (v) v))))
(lambda (z) ((cps-cons x z) (lambda (v) v)))))))))
c))
Apply Rule 1 =>
(lambda (c) ((let ((x 0))
(lambda (c2) (c2 ((set! x (+ x 1))
(lambda (_)
((lambda (c6) (let ((f (lambda (w) (lambda (c7) (c7 (c6 w))))))
((lambda (c8) (c8 f)) (lambda (v) v))))
(lambda (z) ((cps-cons x z) (lambda (v) v)))))))))
c))
Beta Reduction =>
(lambda (c) ((let ((x 0))
(lambda (c2) (c2 ((set! x (+ x 1))
(lambda (_)
((lambda (c6) (let ((f (lambda (w) (lambda (c7) (c7 (c6 w))))))
((lambda (v) v) f)))
(lambda (z) ((cps-cons x z) (lambda (v) v)))))))))
c))
Beta Reduction =>
(lambda (c) ((let ((x 0))
(lambda (c2) (c2 ((set! x (+ x 1))
(lambda (_)
((lambda (c6) (let ((f (lambda (w) (lambda (c7) (c7 (c6 w))))))
f))
(lambda (z) ((cps-cons x z) (lambda (v) v)))))))))
c))
De-CPS =>
(lambda (c) ((let ((x 0))
(lambda (c2) (c2 ((set! x (+ x 1))
(lambda (_)
((lambda (c6) (let ((f (lambda (w) (lambda (c7) (c7 (c6 w))))))
f))
(lambda (z) (cons x z)))))))))
c))
...unfinished due to...

pkhoung on irc.freenode.net made a good point after I was nearly done with the entire exercise. It seems, basically, that once you get to the shift part, the set! is already executed. Putting this another way, the only context captured between shift and reset is the return path from shift to reset Looking back at it, this makes sense as set! it is not in the return path from shift to reset. The following code does work as expected.

(define f
(let ((x 0))
(reset
(let ((y (shift k k)))
(set! x (+ x 1))
x))))

Or even better, we can just pause a computation:

(define f
(reset
(begin
(shift k k)
1)))