PythonライクなGeneratorをSchemeで作ってみた

並列プログラミングについて考えるため、'thread', 'coroutine', 'fiber', 'generator' などを調べていました。その途中でPythonのGeneratorについて書いてある http://linuxgazette.net/100/pramode.html に行き当たり、「なるほどこれは便利なものだな！」と感心したので、ちょっとSchemeで書いてみることにしました。

ライブラリ (tidbits generator)

;;; Ypsilon Scheme System
;;; Copyright (c) 2004-2008 Y.FUJITA, LittleWing Company Limited.
;;; See license.txt for terms and conditions of use.

(library (tidbits generator)
  (export define-generator)
  (import (rnrs) (only (core) format))

  (define unexpected-return
    (lambda (name)
      (assertion-violation
       'iteration
       (format "unexpected return of generator function ~s" name))))
      
  (define-syntax define-generator
    (lambda (x)
      (syntax-case x (lambda)
        ((stx name (lambda formals e0 e1 ...))
         (with-syntax ((yield (datum->syntax #'stx 'yield)))
           #'(define name
               (lambda formals
                 (let ((resume #f) (return #f))
                   (define yield
                     (lambda args
                       (call/cc
                        (lambda (cont)
                          (set! resume cont)
                          (apply return args)))))
                   (lambda ()
                     (call/cc
                      (lambda (cont)
                        (set! return cont)
                        (cond (resume (resume))
                              (else
                               (let () e0 e1 ...)
                               (unexpected-return 'name)))))))))))
        ((stx (name . formals) e0 e1 ...)
         #'(stx name (lambda formals e0 e1 ...))))))

  ) ;[end]

なかなかコンパクトになりました。これもcall/ccのおかげですね :)
ちょっと試してみましょう :D

Ypsilon 0.9.6-trunk/r248 Copyright (c) 2008 Y.Fujita, LittleWing Company Limited.
> (*1)
> (import (tidbits generator))
> (define-generator generate-12
    (lambda ()
      (yield 1)
      (yield 2)))
> (define sequence-12 (generate-12))
> (sequence-12)
1
> (sequence-12)
2
> (sequence-12)
error in iteration: unexpected return of generator function generate-12

(*1) svn trunkをインストールしていない場合には、ここで上のリストをREPLにコピペしてください。(tidbits generator)ライブラリがインポートできるようになります。
ここでgenerate-12がgenerator function、sequence-12がgenerator objectに相当するものとなります。(sequence-12)はPythonのsequence-12.next()に相当します。

generator functionは初期値などに使用するための引数を取ることができます。またyieldは通常の手続きですので以下のような使い方が可能です。

> (define-generator generate-iota
    (lambda (count from)
      (for-each yield (iota count from))))
> (define sequence-iota (generate-iota 5 -10))
> (sequence-iota)
-10
> (sequence-iota)
-9
> (sequence-iota)
...
> (define-generator generate-mv
    (lambda (count from)
      (yield 1 2)
      (yield 3 4)
      (apply yield (iota count from))))
> (define sequence-mv (generate-mv 4 5))
> (sequence-mv)
#<values 1 2>
> (let-values (((a . b) (sequence-mv))) (cons a b))
(3 4)
> (let-values (((a . b) (sequence-mv))) (cons a b))
(5 6 7 8)

http://linuxgazette.net/100/pramode.html にある例をSchemeに書き換えて実行してみます。

(define-generator pi
  (lambda ()
    (let loop ((deno 1.0) (nume 4.0) (value 0.0))
      (let ((new (+ value (/ nume deno))))
        (yield new)
        (loop (+ deno 2.0) (- nume) new)))))

(define pi-seq (pi))

(list (pi-seq) (pi-seq) (pi-seq))
;=> (4.0 2.666666666666667 3.466666666666667)

(define-generator euler-transform ; euler accelerator
  (lambda (seq)
    (define (square x) (* x x))
    (define s0 (seq))
    (define s1 (seq))
    (define s2 (seq))
    (let loop ((s0 s0) (s1 s1) (s2 s2))
      (yield (- s2 (/ (square (- s2 s1)) (+ s0 (- (* 2 s1)) s2))))
      (loop s1 s2 (seq)))))

(define pi-seq/euler (euler-transform (pi)))

(list (pi-seq/euler) (pi-seq/euler) (pi-seq/euler))
;=> (3.166666666666667 3.1333333333333337 3.1452380952380956)

generator functionのeuler-transformはgenerator objectを引数に取っていることに注意してください。これはeuler-transformがgeneratorを呼び出すgeneratorという汎用の部品となっているということです。これは便利なものですね！今まで知りませんでしたよ :p