継続

今年の4年生も勉強会(SICP 読書会?)をやるらしい。素晴らしいことです。長く続けばいいんだけど。
で、講師をする schemer の id:athos がちょっとすごいので、彼の日記にあった限定継続版ジェネレータを普通の継続で書き直してみた。最初は楽勝だろーと思ってたけど、案外時間がかかってしまった。あまりテストしてないんで、とりあえず動くけど自信なし。もっときれいに書ける気がする。
まずベタっと書いてみた版。call/cc の書き方を思い出すために。 (let ((cont #f) ...) のあとにもう一度 (lambda () ... ってのがくるのがはまりポイントだと思われ。これがないともう一度この関数を呼んだときに初期化されてしまう。

(define (fib-maker)
  (let ((cont #f) (cont-exist? #f))
    (lambda ()
      (call/cc
       (lambda (yield)
	 (if cont-exist?
	     (cont #f)
	     (let ((skip-yield? #f))
	       (set! cont-exist? #t)
	       (let loop ((a 1) (b 1))
		 (call/cc (lambda (k) (set! cont k)))
		 (if skip-yield?
		     (begin (set! skip-yield? #f)
			    (loop b (+ a b)))
		     (begin (set! skip-yield? #t)
			    (yield a)))))))))))
(define fib (fib-maker))

一般化してみた。こんなんでいいのだろーか。 scheme むずいな。

(define (yield-maker fun)
  (let ((cont #f) (cont-exist? #f))
    (lambda ()
      (call/cc (lambda (yield)
		 (if cont-exist?
		     (cont #f)
		     (let ((skip-yield? #f))
		       (set! cont-exist? #t)
		       (fun (lambda (x)
			      (call/cc (lambda (k) (set! cont k)))
			      (if skip-yield?
				  (set! skip-yield? #f)	
				  (begin (set! skip-yield? #t)
					 (yield x))))))))))))
(define (fib-generator)
  (yield-maker
   (lambda (yield)
     (let loop ((a 1) (b 1))
       (yield a)
       (loop b (+ a b))))))
(define fib (fib-generator))

結論： id:athos すごい。