[plt-scheme] yield-oriented sequence constructor

I had an idea for doing Python-style yield, but separating out the
sequence (and generator) from the yielding expression.  In particular,
yield is just a top-level procedure rather than being a magic word in
a yield-defining macro (like in Matthias's version on the PLT Scheme
weblog), and a procedure that calls yield is just an ordinary
procedure, rather than being magically transformed into a generator
(like in Python).  By default, yield just prints, but in the dynamic
extent of a sequence constructor, it delivers its arguments to the
sequence's consumer (e.g. an iteration or a generator).  Let me know
if you spot any potential problems with the following implementation
strategy using continuations:

(define (default-yield-proc . vals)
  (for-each (current-print) vals))

(define current-yield-proc
  (make-parameter default-yield-proc))

(define (yield . vals)
  (apply (current-yield-proc) vals))

(define (make-yield-sequence thunk)
  (make-do-sequence
   (lambda ()
     (let ((done (gensym)))
       (values
        (lambda (pos) (apply values (cdr pos)))
        (lambda (pos) (call/cc (car pos)))
        (let/cc return
          (parameterize ((current-yield-proc
                          (let loop ((return return))
                            (lambda vals
                              (current-yield-proc
                               (loop
                                (let/cc continue
                                  (return (cons continue vals)))))))))
            (thunk)
            (yield done)))
        (lambda (pos) (or (null? (cdr pos)) (not (eq? (cadr pos) done))))
        void
        void)))))

(define-syntax in-yields
  (syntax-rules ()
    ((_ expr)
     (make-yield-sequence (lambda () expr)))))

;; Examples:

(yield (for/list ((x (in-yields (begin (yield 1) (yield 2) (yield 3)))))
         x))
;; prints (1 2 3)

(define (yield-each . lists)
  (apply for-each yield lists))

(yield (for/list (((x y) (in-yields (yield-each '(a b c) '(1 2 3)))))
         (cons x y)))
;; prints ((a . 1) (b . 2) (c . 3))

(define yield-fibs
  (case-lambda
    (() (yield-fibs 1 1))
    ((cur next)
     (yield cur)
     (yield-fibs next (+ cur next)))))

(yield (for/list ((f (in-yields (yield-fibs)))
                  (i (in-range 10)))
         f))
;; prints (1 1 2 3 5 8 13 21 34 55)


--dougorleans at gmail.com