SRFI 42でFizzBuzzとフィボナッチ

scheme

SRFI 42は、下のようにいろんなデータでのループに使うことができる。

gosh> (list-ec (: x 1 10) x)
(1 2 3 4 5 6 7 8 9)
gosh> (list-ec (: c "ABCDE") #`"char-,c")       
("char-A" "char-B" "char-C" "char-D" "char-E")
gosh> (list-ec (: x '#(1 2 3) '#(4 5)) (if (odd? x)) x)
(1 3 5)

これは、(: *)という構文で、引数 * の個数と型でディスパッチすることによって実現されている。具体的なディスパッチの条件はこちら。

ディスパッチャをカスタマイズする方法もある。そのためには、(:dispatched *)という形式を使う。

は関数へと評価される式で、その結果の関数dは(list a[1] a[2] ...)を引数にして呼び出される(a[1], a[2], ...は、, *を評価した結果の値)。関数dは1引数の関数gを戻り値として返す。gはループのたびに1つの引数emptyを伴って呼び出される。emptyはループの終了を知らせるための値で、gがemptyを返すとループが終了する。gがそれ以外の値を返せば、それがループの値として使われる。


例として、FizzBuzz、フィボナッチ数を順に返すようなものを作ってみる。

(use util.match)

(define (fizzbuzz n)
  (let* ([i 0] [% (lambda (x) (= (remainder i x) 0))])
    (lambda (break)
      (if (>= i n)
	  break
	  (begin0
	    (cond [(% 15) 'FizzBuzz]
		  [(% 5) 'Buzz]
		  [(% 3) 'Fizz]
		  [else i])
	    (inc! i))))))

(define (fib)
  (let ([cont #f] [return #f])
    (lambda _
      (let/cc cc
        (set! return cc)
        (if cont
	    (cont #f)
	    (let loop ([a 1] [b 0])
	      (let/cc k
		(set! cont k)
		(return a))
	      (loop (+ a b) a)))))))

(define (my-dispatcher args)
  (match args
    [(:fzbz (? integer? n))
     (fizzbuzz n)]
    [(:fib) (fib)]
    [else #f]))

これをSRFI 42のマクロから使ってみる。ただし、fibは停止しないので、:parallelなり:whileなりと一緒に使う必要がある。

gosh> (do-ec (:dispatched x my-dispatcher :fzbz 10) (print x))
FizzBuzz
1
2
Fizz
4
Buzz
Fizz
7
8
Fizz
#
gosh> (list-ec (:parallel (: x "abcdefg") (:dispatched y my-dispatcher :fib)) (cons x y))
（(#\a . 1) (#\b . 1) (#\c . 2) (#\d . 3) (#\e . 5) (#\f . 8) (#\g . 13))
gosh>


ところで、カスタムのディスパッチャを使うたびに:dispatchedと書くのは結構うっとうしかったりする。デフォルトのディスパッチャに統合できると嬉しいと思う。

SRFI 42はそのためのインターフェースも与えていて、:-dispatch-ref, :-dispatch-set!,　dispatch-unionという3つがそのための手続きになっている。それぞれ、現在のディスパッチャを返す手続き、ディスパッチャを書き換える手続き、そして、2つのディスパッチャを足し合わせる手続きだ。
Gaucheでは':'から始まる名前は(キーワードと解釈されてしまうので)手続きの名前として使えない。代わりになるものを探すと、

gosh> (apropos 'dispatch)
dispatch-union                 (srfi-42)
make-initial-:-dispatch        (srfi-42)
srfi-42--dispatch              (srfi-42)
srfi-42--dispatch-ref          (srfi-42)
srfi-42--dispatch-set!         (srfi-42)
srfi-42-dispatched             (srfi-42)
gosh>

という結果から、srfi-42--dispatch-ref, srfi-42--dispatch-set!がそうらしい(このあたりはドキュメント化されていない様子)。


そこで、

(srfi-42--dispatch-set! (dispatch-union (srfi-42--dispatch-ref) my-dispatcher))

というコードを付け加えれば、さっきの例は

(do-ec (: x :fzbz 10) (print x))
(list-ec (:parallel (: x "abcdefg") (: y :fib)) (cons x y))

というふうにすることができる。