まずコルーチンを実装します。
Scheme は継続(Continuation)を扱えるので、簡単にコルーチンを実装できます。
(use util.queue)
(define *tasks* (make-queue))
(define-syntax define-coroutine
(syntax-rules ()
((_ (routine yield) body ...)
(define (routine)
(call/cc (lambda (return)
(define (yield)
(call/cc (lambda (cont)
(enqueue! *tasks* cont)
(return))))
body ...))
((dequeue! *tasks*))))
((_ (routine yield exit) body ...)
(define (routine)
(call/cc (lambda (escape)
(call/cc (lambda (return)
(define (yield)
(call/cc (lambda (cont)
(enqueue! *tasks* cont)
(return))))
(define (exit)
(call/cc (lambda (cont)
(enqueue! *tasks* cont)
(escape))))
body ...))
((dequeue! *tasks*))))))))
(define (coroutine-init! . rs)
(set! *tasks* (make-queue))
(for-each (lambda (r)
(enqueue! *tasks* r))
rs))
(define (coroutine-add! r) (enqueue! *tasks* r))
(define (coroutine-del!) (dequeue! *tasks*))
(define (coroutine-restart!) ((dequeue! *tasks*)))
(define (coroutine-skip!) (coroutine-add! (coroutine-del!)))普段はマクロなんて使わないので、Gauche 本に載ってたソースだったかも知れない。たぶんそうｗ
コルーチンの解説もあるので、Scheme でコルーチンしたい人はぜひ。
実装したコルーチンを使用して FizzBuzz を実装してみます。
(define (print-fizz-buzz limit)
(define (devidable? m n) (= (remainder m n) 0))
(define (fizz? n) (devidable? n 3))
(define (buzz? n) (devidable? n 5))
(define (fizz-buzz? n) (and (fizz? n) (buzz? n)))
(define *output* (cons 0 ""))
(define (request-output! priority output)
(and (> priority (car *output*))
(set! *output* (cons priority output))))
(define (init-request!) (set! *output* (cons 0 "")))
(define (get-request-output) (cdr *output*))
(define-coroutine (cr-number yield)
(let lp ((c 0))
(inc! c)
(request-output! 10 c)
(yield)
(lp c)))
(define-coroutine (cr-fizz yield)
(let lp ((c 0))
(inc! c)
(and (fizz? c) (request-output! 30 'fizz))
(yield)
(lp c)))
(define-coroutine (cr-buzz yield)
(let lp ((c 0))
(inc! c)
(and (buzz? c) (request-output! 20 'buzz))
(yield)
(lp c)))
(define-coroutine (cr-fizz-buzz yield)
(let lp ((c 0))
(inc! c)
(and (fizz-buzz? c) (request-output! 40 'fizz-buzz))
(yield)
(lp c)))
(define-coroutine (cr-limitter yield exit)
(let lp ((c 0))
(inc! c)
(if (>= c limit)
(begin (newline) (exit))
(yield))
(lp c)))
(define-coroutine (cr-printer yield)
(let lp ()
(display (get-request-output))
(display " ")
(init-request!)
(yield)
(lp)))
(coroutine-init! cr-fizz cr-buzz cr-fizz-buzz cr-limitter cr-printer)
(cr-number))簡単に解説すると、各コルーチンは並行的に実行するので、各コルーチンは
コルーチン１号「おれ出力する！」
コルーチン２号「おれも出力する！」
コルーチン３号「いや、おれが出力するし！」
コルーチン４号「いや、おれだって！」
コルーチン５号「おれも！おれも！」
コルーチン６号「はいはい、優先度の一番高い奴を出力するから、おまえら喧嘩すんな」
コルーチン７号「(表示回数をチェックして)いい加減おまえら全員出力やめれ！」
みたいな感じになっています。コルーチンは単にそれぞれ動作するだけなので、コルーチン間で協調して動作するためには、アプリケーションとして仕組みを用意しなければなりません。
つまり、出力に優先度を付けることで、出力を調整するコルーチンを用意します。また、表示回数をチェックするコルーチンを用意して、コルーチン全体の動作を停止できるようにします。
実行してみます。
gosh> (print-fizz-buzz 100) 1 2 fizz 4 buzz fizz 7 8 fizz buzz 11 fizz 13 14 fizz-buzz 16 17 fizz 19 buzz fizz 22 23 fizz buzz 26 fizz 28 29 fizz-buzz 31 32 fizz 34 buzz fizz 37 38 fizz buzz 41 fizz 43 44 fizz-buzz 46 47 fizz 49 buzz fizz 52 53 fizz buzz 56 fizz 58 59 fizz-buzz 61 62 fizz 64 buzz fizz 67 68 fizz buzz 71 fizz 73 74 fizz-buzz 76 77 fizz 79 buzz fizz 82 83 fizz buzz 86 fizz 88 89 fizz-buzz 91 92 fizz 94 buzz fizz 97 98 fizz
limit 番目が出ないバグがあります。
以下のようにコルーチン cr-limitter を修正してと。
(define-coroutine (cr-limitter yield exit)
(let lp ((c 0))
(inc! c)
(if (> c limit) ;; <--- イコールを取る
(begin (newline) (exit))
(yield))
(lp c)))再実行してみます。
gosh> (print-fizz-buzz 100) 1 2 fizz 4 buzz fizz 7 8 fizz buzz 11 fizz 13 14 fizz-buzz 16 17 fizz 19 buzz fizz 22 23 fizz buzz 26 fizz 28 29 fizz-buzz 31 32 fizz 34 buzz fizz 37 38 fizz buzz 41 fizz 43 44 fizz-buzz 46 47 fizz 49 buzz fizz 52 53 fizz buzz 56 fizz 58 59 fizz-buzz 61 62 fizz 64 buzz fizz 67 68 fizz buzz 71 fizz 73 74 fizz-buzz 76 77 fizz 79 buzz fizz 82 83 fizz buzz 86 fizz 88 89 fizz-buzz 91 92 fizz 94 buzz fizz 97 98 fizz buzz
今度は正しい結果が得られました。
