;;;Python-like generators in Scheme
 ;;;
 ;;;Michele Simionato (michele.simionato@gmail.com) May 2005
 ;;;Adapted from http://c2.com/cgi/wiki?SchemeCoroutineExample

 (define-macro (store/cc! name . body)
   (let ((k (gensym)))
    `(call-with-current-continuation 
      (lambda (,k) (set! ,name ,k) ,@body))))

 ; to spare parenthesis, real schemers will hate this one ;)
 (define-macro (let/ name value . args) 
   `(match-let ((,name ,value)) ,@args))

 ;; the core implementation
 (define (generator routine)
   (let/ (current status exit next) (list routine 'suspended #f #f)
     (match-lambda*
      (() (if (eq? status 'dead)
	      (error 'dead-generator)
	      (let/ continuation-and-value
		(store/cc! exit
		   (let/ yield
		      (lambda (value)
			(store/cc! next
			   (exit (cons next value))))
		      (current yield) ; exits from here,
		      ;; except after the last yield
		      (set! status 'dead)
		      (error 'dead-generator)))
		(if (pair? continuation-and-value)
		    (begin (set! current (car continuation-and-value))
			   (cdr continuation-and-value))
		    continuation-and-value))))
      (('status?) status)
      (('dead?) (eq? status 'dead))
      (('alive?) (not (eq? status 'dead)))
      (('kill!) (set! status 'dead)))))

 ;; an example
 (define test
   (generator (lambda (yield)
		(yield "HELLO!")
		(yield "WORLD!"))))

 (test 'status?) ; suspended
 (test 'dead?) ; #f
 (test 'alive?) ; #t
 (test) ; "HELLO!"
 (test) ; "WORLD!"
 (test) ; Error: dead-generator
 (test 'status?) ; dead
 (test 'dead?) ; #t

 ;; another example:

 (define (list->iterator list)
   (generator (lambda (yield)
		(for-each yield list))))

 (define (iterator-empty? iterator)
   (iterator 'dead?))

 (define my-iterator
   (list->iterator (list 1 2 3)))

 (my-iterator) ; 1
 (my-iterator) ; 2
 (my-iterator) ; 3
 (iterator-empty? my-iterator) ; #f

This required me to install the low-level-macros egg. And when I pasted the generator routine I got

--->       (('kill!) (set! status 'dead)))))

Error: illegal non-atomic object: ()
inside expression `(match-lambda* ...)'

        Call history:

        <eval>    (##sys#apply ##sys#values args315)
        <eval>    (apply297 (lambda298 (_253 name value args) (begin254 (quasiquote (match-let (((unquote name) (unquo......
        <eval>    (##sys#cons (##core#quote match-let) (##sys#cons (##sys#list (##sys#list name value)) args))
        <eval>    (##sys#cons (##sys#list (##sys#list name value)) args)
        <eval>    (##sys#list (##sys#list name value))
        <eval>    (##sys#list name value)
        <syntax>          [generator] (##core#begin (match-let364 (((current status exit next) (list routine (quote suspended) #f #f))) (m......
        <syntax>          [generator] (match-let364 (((current status exit next) (list routine (quote suspended) #f #f))) (match-lambda* (()...
        <syntax>          [generator] (((current status exit next) (list routine (quote suspended) #f #f)))
        <syntax>          [generator] ((current status exit next) (list routine (quote suspended) #f #f))
        <syntax>          [generator] (current status exit next)
        <syntax>          [generator] (list routine (quote suspended) #f #f)
        <syntax>          [generator] (quote suspended)
        <syntax>          [generator] (##core#quote suspended)
        <syntax>          [generator] (match-lambda* (() (if (eq? status (quote dead)) (error (quote dead-generator)) (let/ continuation-a......
        <syntax>          [generator] (() (if (eq? status (quote dead)) (error (quote dead-generator)) (let/ continuation-and-value (store......        <--