s c h e m a t i c s : c o o k b o o k

(require (lib "class.ss"))

(define iterator%
   (class object%
     (init-field initial-k)
     (define k initial-k)
     (define set-k! (lambda (c) (set! k c)))
     
     (define/public (next)
       (let/cc cc
         (raise (let/cc raise-cc
           (cc (k (list set-k! cc raise-cc)))))))

     (define/public (reset)
        (set! k initial-k))
        
     (super-new)))

(define-struct (exn:stop-iteration exn) ())

(define-syntax (define-gen stx)
  (syntax-case stx ()
    [(_ (id args ...) bodies ...)
     (with-syntax ([yield (datum->syntax-object stx 'yield)]
                   [return (datum->syntax-object stx 'return)])
     #`(define (id args ...)
         (make-object iterator%
           (lambda (set-k!&ec&raise)
             (define-values (set-k! ec raise) (values #f #f #f))
             (define (set-values the-set-k! the-ec the-raise)
               (set! set-k! the-set-k!)
               (set! ec the-ec)
               (set! raise the-raise))
             (define (return)
               (raise (make-exn:stop-iteration "StopIteration"
                                               (current-continuation-marks))))
             (define (yield x)
               (apply set-values
                      (let/cc k
                        (set-k! k)
                        (ec x))))
             (apply set-values set-k!&ec&raise)
             (with-handlers ([void raise])
               (begin bodies ...)
               (return))))))]))

(define-gen (iter lst)
  (for-each yield
            lst))

> (define i (iter '(1 2 3)))
> (send i next)
1
> (send i next)
2
> (send i next)
3
> (send i next)
StopIteration