18 August 2006

One More Example of Python Generators in Scheme

I've had some spare time at work these past few days waiting for modestly long-running data analysis procedures to complete. Unfortunately, this spare time comes in ~5 min chunks, so it's not really worth a serious context switch into other work-related stuff. So, I've been doing a lot of little things---like web browsing about Python generators in scheme. I'm unable to resist posting my own implementation of generators here. The interesting thing about these (as opposed to the two I've linked to above) is that they allow multiple-value yields. Probably not terribly efficient (I think I could get away with let/ec, for example), but nonetheless fun.
(module generators mzscheme
  (provide define-generator)
  
  (define-syntax define-generator
    (lambda (stx)
      (syntax-case stx ()
        ((define-generator (name arg ...) body0 body1 ...)
         (with-syntax ((yield (datum->syntax-object 
                               (syntax body0) 
                               'yield)))
           (syntax
            (define (name arg ...)
              (letrec ((continue-k #f)
                       (return-k #f)
                       (yield
                        (lambda args
                          (let/cc cont
                            (set! continue-k cont)
                            (call-with-values 
                             (lambda () (apply values args)) 
                             return-k)))))
                (lambda ()
                  (let/cc ret
                    (set! return-k ret)
                    (if continue-k
                        (continue-k '())
                        (begin
                          body0 body1 ...
                          (error 'name "reached end of generator values"))))))))))))))

Examples of use:

> (require generators)
> (define-generator (nums-from n)
    (let loop ((i n))
      (yield i)
      (loop (+ i 1))))
> (define ten-up (nums-from 10))
> (ten-up)
10
> (ten-up)
11
> (ten-up)
12
> (ten-up)
13
> (ten-up)
14
and
> (define-generator (next-two-from n)
    (let loop ((i n))
      (yield i (+ i 1))
      (loop (+ i 2))))
> (define ten-by-twos (next-two-from 10))
> (let-values (((a b)
                (ten-by-twos)))
    (+ a b))
21
> (ten-by-twos)
12
13

1 comment:

Derick said...

Thanks Will. I've cleaned it up a bit, made it into an R6RS library, made it raise a distinct condition type similar to Python, and separated it into procedural and syntactic layers:

#!r6rs
(library (xitomatl generators)
(export
make-generator
define-generator
&generator-finished?)
(import
(rnrs))

;; Modified from Will Farr's generators example:
;; http://wmfarr.blogspot.com/2006/08/one-more-example-of-python-generators.html

(define-condition-type &generator-finished &condition
make-&generator-finished &generator-finished?)

(define (make-generator proc)
(letrec ([resume (lambda ()
(proc yield)
(raise (make-&generator-finished)))]
[return #f]
[yield (lambda args
(call/cc
(lambda (k)
(set! resume k)
(apply return args))))])
(lambda ()
(call/cc
(lambda (k)
(set! return k)
(resume))))))

(define-syntax define-generator
(lambda (stx)
(syntax-case stx ()
[(ctxt (name . frmls) b0 b ...)
(with-syntax ([yield (datum->syntax #'ctxt 'yield)])
#'(define (name . frmls)
(make-generator
(lambda (yield)
b0 b ...))))])))

)

Example:

Ikarus Scheme version 0.0.3+ (revision 1495, build 2008-05-31)
Copyright (c) 2006-2008 Abdulaziz Ghuloum

> (import (xitomatl generators))
>
> (define-generator (G n)
(do ([i 0 (add1 i)])
[(= i n)]
(apply yield (make-list i 'x))))
>
> (define g (G 4))
> (g)
> (g)
x
> (g)
x
x
> (g)
x
x
x
> (g)
Unhandled exception
Condition components:
1. &generator-finished
>