; generator push-back
(import (rnrs hashtables (6)))
(define (identity x) x)
(define-syntax while
(syntax-rules ()
((while pred? body ...)
(do () ((not pred?)) body ...))))
(define-syntax define-generator
(lambda (x)
(syntax-case x (lambda)
((stx name (lambda formals e0 e1 ...))
(with-syntax ((yield (datum->syntax (syntax stx) 'yield)))
(syntax (define name
(lambda formals
(let ((resume #f) (return #f))
(define yield
(lambda args
(call-with-current-continuation
(lambda (cont)
(set! resume cont)
(apply return args)))))
(lambda ()
(call-with-current-continuation
(lambda (cont)
(set! return cont)
(cond (resume (resume))
(else (let () e0 e1 ...)
(error 'name "unexpected return"))))))))))))
((stx (name . formals) e0 e1 ...)
(syntax (stx name (lambda formals e0 e1 ...)))))))
(define-generator (primegen)
(yield 2) (yield 3)
(let* ((ps (primegen))
(p (and (ps) (ps)))
(q (* p p))
(d (make-eq-hashtable)))
(define (add m s)
(while (hashtable-contains? d m)
(set! m (+ m s)))
(hashtable-set! d m s))
(do ((c (+ p 2) (+ c 2))) (#f)
(cond ((hashtable-contains? d c)
(let ((s (hashtable-ref d c #f)))
(hashtable-delete! d c)
(add (+ c s) s)))
((< c q) (yield c))
(else (add (+ c p p) (+ p p))
(set! p (ps))
(set! q (* p p)))))))
(define-generator (pushback val gen)
(yield val) (while #t (yield (gen))))
(define ps (primegen))
(display (ps)) (newline)
(display (ps)) (newline)
(display (ps)) (newline)
(display (ps)) (newline)
(display (ps)) (newline)
(display (ps)) (newline)
(display (ps)) (newline)
(set! ps (pushback 17 ps))
(display (ps)) (newline)
(display (ps)) (newline)
(display (ps)) (newline)
(display (ps)) (newline)
(display (ps)) (newline)