yield.rkt
#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 ;; Adds #f as the last return value of the body.
  (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)