[plt-scheme] call/cc vs let/cc at top level - A BUG?

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Below you will find a longish piece of code that I believe 
demonstrates a bug
;;; in let/cc vs call/cc. This exploration was initiated upon reading a 
post of
;;; Jens Axel's on comp.lang.scheme regarding call/cc in the presence of 
parameters.
;;; At the time I read the post I figured that something else might be 
wrong
;;; despite his demonstrating valid results from an R5Rs perspective, 
although what
;;; was considered valid seemed up to some debate. It even brought Oleg 
Kiselyov
;;; in to comment that this was a tricky area.
;;;
;;; What I demonstrate below is that their is a qualitative difference 
between the
;;; behavior of both let/cc and call/cc based on whether they are called 
at top level
;;; vs module top-level, unit top-level or being within a let clause. 
Further, I
;;; demonstrate that there is a qualitative difference in the results 
returned by
;;; call/cc vs let/cc at true top-level. Finally I demonstrate 
equivalent code using
;;; delimited continuation primitives that show consistency regardless 
of the different
;;; environments they are placed in: module, unit, let-clause or top-level.
;;;
;;; While there may be explanations for the differing behavior of 
call/cc and let/cc
;;; as regards their individual changes in behavior when at true 
top-level vs at any
;;; other time (although I don't know what it would be), I consider the 
difference
;;; between call/cc and let/cc to likely represent a legitimate bug, as 
(let/cc k expr) is
;;; supposed to be simple short hand for (call/cc (lambda (k) expr)). It 
is possible
;;; that the behavior is sensitive to being within the syntax that 
defines let/cc.
;;; I know that I could not use my standard display->string debugging 
syntax so I could
;;; show all the values having been checked, because it caused their 
behavior to change
;;; when the expression was placed inside the macro.
;;;
;;; I'm sorry for the length of the code, it's just that I wanted to 
show every case.
;;; Additionally, I've included a small portion of my utils.scm module, 
where I keep my
;;; debugging, and frequently used syntax and functions. It's 
introduction at the top
;;; is simply to allow me to use my standard debug print routines, and 
it also stores
;;; my syntax that allows for operator like names for the delimited 
continuation primitives
;;; and restructures them so that the procedures they call are all in 
last position
;;; relative to other arguments, which makes them easier to compose with 
code.
;;;
;;; This entire post is executable Scheme. I've commented out those 
sections of code that
;;; if run would cause a never ending loop. I would be very interested 
to know how this
;;; code behaves in say version 360, prior to the integration of prompts 
into the REPL
;;; of DrScheme. All this code was run using v369.2 of DrScheme. It may 
well behave
;;; differently under MzScheme, but I haven't tried that as of yet.
;;;
;;; Happy New Year to all. I appreciate any attention to this that you 
can afford.
;;;
;;; --kyle
;;; airfoil at bellsouth dot com
;;; shcemekeys.blogspot.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(require (lib "unit.ss"))

(module utils mzscheme

(provide (all-defined))

(define-syntax let/wcc
(lambda (stx)
(syntax-case stx ()
((_ k tag . body )
#'(call-with-composable-continuation (lambda (k) . body) tag)))))

(define-syntax @@
(lambda (stx)
(syntax-case stx ()
((_ tag handler . body)
#'(call-with-continuation-prompt (lambda () . body) tag handler)))))

(define-syntax !!
(lambda (stx)
(syntax-case stx ()
((_ tag . args) #'(abort-current-continuation tag . args)))))

(define-syntax @
(lambda (stx)
(syntax-case stx ()
((_ ) #'(default-continuation-prompt-tag)))))

(define-syntax cout
(λ (stx)
(syntax-case stx ()
((_ e1 e2 ...) #'(begin (printf "~s " e1) (cout e2 ...)))
((_ e1 ) #'(printf "~s~n" e1))
((x ) (identifier? #'x) #'(newline)))))

(define-syntax couta
(λ (stx)
(syntax-case stx ()
((_ e1 e2 ...) #'(begin (printf "~a " e1) (couta e2 ...)))
((_ e1 ) #'(printf "~a~n" e1))
((x ) (identifier? #'x) #'(newline)))))

)
(require utils)

;;;In this example the code loops forever
(module a mzscheme
(require utils)
(define p (make-parameter 1))
(define cc 'takes-a-continuation)
(call/cc (lambda (k) (set! cc k)))
(cout 'a= (p))
(couta "111111111111111111111111111")
(cc 10)
(couta "222222222222222222222222222")
(p 2)
(couta "333333333333333333333333333")
(cc 10)
(couta "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
)
;(require a)
#|
a= 1
111111111111111111111111111
a= 1
111111111111111111111111111
...
forever
|#

;;;Inside a unit it does the same as being in a module, repeating a=1 
111111111111111111111111
(define-unit ua@
(import)
(export)
(define p (make-parameter 1))
(define cc 'takes-a-continuation)
(begin
(call/cc (lambda (k) (set! cc k)))
(cout 'a= (p)))
(couta "111111111111111111111111111")
(cc 10)
(couta "222222222222222222222222222")
(p 2)
(couta "333333333333333333333333333")
(cc 10)
(couta "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
)
;(invoke-unit ua@)
#|
=>
a= 1
111111111111111111111111111
a= 1
111111111111111111111111111
...
forever
|#

;;;But the same code outside of a module, at top-level, it terminates 
correctly
(define p (make-parameter 1))
(define cc 'takes-a-continuation)
(begin
(call/cc (lambda (k) (set! cc k)))
(cout 'a= (p)))
(couta "111111111111111111111111111")
(cc 10)
(couta "222222222222222222222222222")
(p 2)
(couta "333333333333333333333333333")
(cc 10)
(couta "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
#|
=>
a= 1
111111111111111111111111
a= 1
222222222222222222222222
333333333333333333333333
a= 2
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; So I tried the same code outside a module, but nested within a let, 
so it was no longer at top level. ;;;;
;;; The result was the same forever repeating pattern as when the code 
was in a module or a unit. ;;;;
;;; This tells me that the difference has to do with being at top level, 
not with being within a module or unit. ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;(let ()
; (define p (make-parameter 1))
; (define cc 'takes-a-continuation)
; (begin
; (call/cc (lambda (k) (set! cc k)))
; (cout 'a= (p)))
; (couta "111111111111111111111111111")
; (cc 10)
; (couta "222222222222222222222222222")
; (p 2)
; (couta "333333333333333333333333333")
; (cc 10)
; (couta "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
;)
#|
=>
a= 1
111111111111111111111111111
a= 1
111111111111111111111111111
...
forever
|#

;;; On a hunch, I tried let/cc inside a module, which gives slightly 
different, yet repeating results
(module b mzscheme
(require utils)
(define p (make-parameter 1))
(define cc 'takes-a-continuation)
(begin
(let/cc k (set! cc k)
(cout 'b= (p))))
(couta "111111111111111111111111111")
(cc 10)
(couta "222222222222222222222222222")
(p 2)
(couta "333333333333333333333333333")
(cc 10)
(couta "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
)
;(require b)
#|
b= 1
111111111111111111111111111111111
111111111111111111111111111111111
...
forever
|#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; More surprising, (possibly a bug), is that it terminates, but with 
mutated values at top-level ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define p (make-parameter 1))
(define cc 'takes-a-continuation)
(begin
(let/cc k (set! cc k)
(cout 'b= (p))))
(couta "111111111111111111111111111")
(cc 10)
(couta "222222222222222222222222222")
(p 2)
(couta "333333333333333333333333333")
(cc 10)
(couta "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
#|
=>
b= 1
111111111111111111111111111
10
222222222222222222222222222
333333333333333333333333333
10
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|#
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Using delimited continuations yields consistent behavior ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module c mzscheme
(require utils)
(define p (make-parameter 1))
(define cc 'takes-a-continuation)
(@@ (@) #f
(let/wcc k (@) (set! cc k))
(cout 'c= (p)))
(couta "111111111111111111111111111")
(cc 10)
(couta "222222222222222222222222222")
(p 2)
(couta "333333333333333333333333333")
(cc 10)
(couta "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
)
(require c)
#|
=>
c= 1
111111111111111111111111111
c= 1
222222222222222222222222222
333333333333333333333333333
c= 2
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|#

;;;The same results are returned when the code is in a unit
(define-unit uc@
(import)
(export)
(define p (make-parameter 1))
(define cc 'takes-a-continuation)
(@@ (@) #f
(let/wcc k (@) (set! cc k))
(cout 'uc= (p)))
(couta "11111111UCUCUCUC11111111111")
(cc 10)
(couta "22222222UCUCUCUC22222222222")
(p 2)
(couta "33333333UCUCUCUC33333333333")
(cc 10)
(couta "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
)
(invoke-unit uc@)
#|
=>
uc= 1
11111111UCUCUCUC11111111111
uc= 1
22222222UCUCUCUC22222222222
33333333UCUCUCUC33333333333
uc= 2
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|#

;;;The same results are returned with a custom prompt tag
(define-unit uc-tag1@
(import)
(export)
(define p (make-parameter 1))
(define cc 'takes-a-continuation)
(define tag1 (make-continuation-prompt-tag '=1))
(@@ tag1 #f
(let/wcc k tag1 (set! cc k))
(cout 'uc-tag1= (p)))
(couta "111111111*TAG_1*111111111111")
(cc 10)
(couta "222222222*TAG_1*22222222222")
(p 2)
(couta "333333333*TAG_1*33333333333")
(cc 10)
(couta "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
)
(invoke-unit uc-tag1@)
#|
=>
uc-tag1= 1
111111111*TAG_1*111111111111
uc-tag1= 1
222222222*TAG_1*22222222222
333333333*TAG_1*33333333333
uc-tag1= 2
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|#

;;; The same results are returned when the partial continuation code is 
operating inside a let clause
(let ()
(define p (make-parameter 1))
(define cc 'takes-a-continuation)
(define tag1 (make-continuation-prompt-tag '=1))
(@@ tag1 #f
(let/wcc k tag1 (set! cc k))
(cout 'LET-tag1= (p)))
(couta "111111111*LET-TAG_1*111111111111")
(cc 10)
(couta "222222222*LET-TAG_1*22222222222")
(p 2)
(couta "333333333*LET-TAG_1*33333333333")
(cc 10)
(couta "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
)
#|
=>
LET-tag1= 1
111111111*LET-TAG_1*111111111111
LET-tag1= 1
222222222*LET-TAG_1*22222222222
333333333*LET-TAG_1*33333333333
LET-tag1= 2
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|#

;;; And finally, the same results are returned when the partial 
continuation code is operating at top-level
(define p (make-parameter 1))
(define cc 'takes-a-continuation)
(define tag1 (make-continuation-prompt-tag '=1))
(@@ tag1 #f
(let/wcc k tag1 (set! cc k))
(cout 'TOP-tag1= (p)))
(couta "111111111*TOP-TAG_1*111111111111")
(cc 10)
(couta "222222222*TOP-TAG_1*22222222222")
(p 2)
(couta "333333333*TOP-TAG_1*33333333333")
(cc 10)
(couta "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")

#|
=>
TOP-tag1= 1
111111111*TOP-TAG_1*111111111111
TOP-tag1= 1
222222222*TOP-TAG_1*22222222222
333333333*TOP-TAG_1*33333333333
TOP-tag1= 2
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|#