#lang racket
(define-struct end-of-generator* ())
(define end-of-generator (make-end-of-generator*))
(define end-of-generator? end-of-generator*?)
(provide end-of-generator end-of-generator?)
(define return-continuation (make-parameter #f))
(define-syntax add-false (syntax-rules ()
((_ . body) (call-with-values (λ () . body)
(λ return-values
(apply values (append return-values (list #f))))))))
(define (yield . yield-values)
(call-with-values
(λ ()
(call/cc
(λ (resume-cont)
(apply yield-resume (cons resume-cont yield-values)))))
(λ resume-values
(let ((new-return-cont (last resume-values)))
(return-continuation new-return-cont)
(apply values (reverse (cdr (reverse resume-values))))))))
(define (yield-resume resume-cont . values)
(let ((wrapped-resume-cont
(λ resume-values
(call/cc (λ (new-return-continuation)
(apply resume-cont (append resume-values (list new-return-continuation))))))))
(apply (return-continuation) (append values (list wrapped-resume-cont)))))
(define-syntax let/yield
(syntax-rules ()
((_ loop-name ((var def) ...) . body)
(call/cc (λ (cc)
(parameterize ((return-continuation cc))
(add-false
(let loop-name ((var def) ...) . body))))))
((_ ((var def) ...) . body)
(call/cc (λ (cc)
(parameterize ((return-continuation cc))
(add-false
(let ((var def) ...) . body))))))))
(define-syntax define/yield
(syntax-rules ()
((_ (name . lambda-list) . body)
(define (name . lambda-list)
(let/yield () . body)))))
(define/yield (numbers)
(let loop-forever ((n 0))
(cond ((> n 5)
n)
(else
(yield n)
(loop-forever (add1 n))))))
(define-syntax generator
(syntax-rules ()
((_ loop-name ((var value) ...) . body)
(let ((next-run #f)
(end? #f))
(λ resume-values
(call-with-values
(λ ()
(cond (end? (values end-of-generator #f))
(next-run
(begin
(apply next-run resume-values)))
(else
(let/yield loop-name ((var value) ...) . body))))
(λ yield-values
(set! next-run (last yield-values))
(when (not next-run)
(set! end? #t))
(apply values (reverse (cdr (reverse yield-values)))))))))
((_ let-defs . body)
(generator no-loop-name let-defs body))))
(define ht (make-hash))
(hash-set! ht 'a 1)
(hash-set! ht 'b 2)
(hash-set! ht 'c 3)
(define g (generator ()
(hash-for-each ht
(λ (k v)
(yield k v)
#t))
(yield 'no-more 'keys)
(values end-of-generator end-of-generator)))
(define-values (n next) (let/yield loop ((x 0))
(cond ((> x 5)
x)
((yield x)
(loop (add1 x))))))
(provide yield let/yield define/yield)