Weird thing happening with call/cc, Why?

Question

I simulated a state-programming solution from On Lisp to solve tree-flatten:

#lang racket

(define (flat-tree-generator tr)
    (define initial? #t)
    (define state '())
    (define (resume)
        (if (null? state)
            '()
            (let ((cont (car state)))
                (set! state (cdr state))
                (cont))))
    (define (recur tr) 
        (cond 
            ((null? tr) (resume))
            ((not (pair? tr)) tr)
            (else (call/cc 
                    (lambda (k)
                        (set! state 
                            (cons 
                              (lambda () (k (recur (cdr tr)))) 
                              state))
                        (recur (car tr)))))))
    (define (dispatch)
        (if initial?
            (begin (set! initial? #f) (recur tr))
            (resume)))
    dispatch)


(define g1 (flat-tree-generator '((0 (1 2)) (3 4))))
(define g2 (flat-tree-generator '(0 1 2 3 4)))

OK, now if you try:

(g1)(g2)(g1)(g2)(g1)(g2)(g1)(g2)(g1)(g2)

It will work as expected (output lines 0011223344). However, if you try this:

(for ([e1 (in-producer g1 '())]
      [e2 (in-producer g2 '())])
    (printf "e1: ~a  e2: ~a\n" e1 e2))

You will get:

e1: 0  e2: 0
e1: 0  e2: 1
e1: 0  e2: 2
e1: 0  e2: 3
e1: 0  e2: 4

Or you try:

(define (test)
    (g1)(g2)(g1)(g2)(g1)(g2)(g1)(g2)(g1)(g2))
(test)

You will get:

'()

I am really confused.. Why?

Answer 1

Just for reference. In my solution, when I wrap the whole dispatch body in a continuation and save it in yield, and in recur I force its return value to go to dispatch's continuation i.e. yield, every thing works fine:

(define (flat-tree-generator tr)
    (define initial? #t)
    (define state '())
    (define yield #f) ; here is change 1
    (define (resume)
        (if (null? state)
            '()
            (let ((cont (car state)))
                (set! state (cdr state))
                (cont))))
    (define (recur tr) 
        (cond 
            ((null? tr) (resume))
            ((not (pair? tr)) tr)
            (else (call/cc 
                    (lambda (k)
                        (set! state 
                            (cons 
                              (lambda () (k (recur (cdr tr)))) 
                              state))
                        (yield (recur (car tr)))))))) ;here is the change 2
    (define (dispatch)
        (call/cc (lambda (cc) ;here is the change 3
            (set! yield cc)
            (if initial?
                (begin (set! initial? #f) (recur tr))
                (resume)))))
    dispatch)

This is inspired by the far more elegant solution of the book Teach Yourself Scheme in Fixnum Days, (also I recommend this book for scheme beginners, it's easy to understand and the examples are good):

(define tree->generator
  (lambda (tree)
    (let ((caller '*))
      (letrec
          ((generate-leaves
            (lambda ()
              (let loop ((tree tree))
                (cond ((null? tree) 'skip)
                      ((pair? tree)
                       (loop (car tree))
                       (loop (cdr tree)))
                      (else
                       (call/cc
                        (lambda (rest-of-tree)
                          (set! generate-leaves
                            (lambda ()
                              (rest-of-tree 'resume)))
                          (caller tree))))))
              (caller '()))))
        (lambda ()
          (call/cc
           (lambda (k)
             (set! caller k)
             (generate-leaves))))))))

Finally, this is my experience in this problem: if a procedure A(such as dispatch) will enter a previous continuation (via calling resume) to get some data, you'd better make sure you can go back with these data to A's continuation.

Answer 2

To solve this with continuations, I find it helpful to use continuations both in the producer and in the dispatcher; this way you flip-flop between both. But it's slightly mind-bending, and non-cc-based solutions are definitely way easier to understand.

A sample implementation is below. I recommend using the Racket debugger step-by-step to completely understand the flow of execution.

(define (flat-tree lst)
  ; main procedure
  (define (go lst k-dp)
    (cond
      ((null? lst) k-dp)
      ((pair? lst) (go (cdr lst) (go (car lst) k-dp)))
      (else        (let/cc k-go (k-dp (cons lst k-go))))))
  ; saved continuation
  (define k-go #f)
  ; dispatcher
  (thunk
   (define ret (let/cc k-dp (if k-go (k-go k-dp) (go lst k-dp))))
   (if (pair? ret)
       (begin
         (set! k-go (cdr ret))
         (car ret))
       null)))

testing:

(define g1 (flat-tree '((a (b c)) (d e (f (g (h)))))))
(define g2 (flat-tree '(0 1 2 3 4 (5 (6 . 7)))))
(for ([e1 (in-producer g1 null)] [e2 (in-producer g2 null)])
  (printf "e1: ~a  e2: ~a\n" e1 e2))

yields

e1: a  e2: 0
e1: b  e2: 1
e1: c  e2: 2
e1: d  e2: 3
e1: e  e2: 4
e1: f  e2: 5
e1: g  e2: 6
e1: h  e2: 7

Answer 3

When you do call-with-current-continuation in REPL you have guards between each statement while in test you will end up after the first (g2) after executing the second unless tr is null. Eg. it will execute the second (g2) and (g1) in a loop since you end up before the code you just executed until you hit (not (pair? tr)) then the you do g2 and g1 3 times with emty list.

You really don't need call/cc to do this at all. It's enough with closures:

(define (flat-tree-generator tr)
  (define initial? #t)
  (define state '())
  (define (resume)
    (if (null? state)
        '()
        (let ((cont (car state)))
          (set! state (cdr state))
          (cont))))
  (define (recur tr) 
    (cond 
      ((null? tr) (resume))
      ((not (pair? tr)) tr)
      (else (set! state 
                     (cons 
                      (lambda () (recur (cdr tr))) 
                      state))
               (recur (car tr)))))
  (define (dispatch)
    (if initial?
        (begin (set! initial? #f) (recur tr))
        (resume)))
  dispatch)

Or you really can use Rackets generator features. This code works in the same manner:

(require racket/generator)
(define (flat-tree-generator tr)
  (generator ()
    (let rec ((tr tr))
      (cond ((null? tr) tr)
            ((pair? (car tr)) (rec (car tr))
                              (rec (cdr tr)))
            (else (yield (car tr))
                  (rec (cdr tr)))))))

In both you get the expected behaviour:

(for ([e1 (in-producer g1 '())]
      [e2 (in-producer g2 '())])
    (printf "e1: ~a  e2: ~a\n" e1 e2)) 
; ==> void, side effect prints:
e1: 0  e2: 0
e1: 1  e2: 1
e1: 2  e2: 2
e1: 3  e2: 3
e1: 4  e2: 4