Scheme におけるシグナル機能のひとつはジャンプあるいは非局所制御
のサポートです。具体的にいいますと、Scheme ではプログラム中の
任意の場所へのジャンプをプログラムで制御することができる
ということです。これは、条件節や手続き呼び出しによって可能な、
ずっと限定されたプログラム制御フローの形式と好対照をなしています。
Scheme の非局所制御オペレータは call-with-continuation
という名の
手続きです。このオペレータをつかってどのように、ハッとさせるような
制御イディオムの数々を作りあげるのかをみていきましょう。
call-with-current-continuation
オペレータ call-with-current-continuation
はその引数
(これは一引数の手続きでなければなりません)を
「現在の継続(current continuation)」とよばれる値と
ともに呼び出します。すくなくともこれが、名前の
説明です。しかし、これは長い名前なので、call/cc
と略される
ことがよくあります。1
プログラムの実行中のあらゆる点での現在の継続は プログラムの残りの部分の抽象です。 したがって、次のプログラム
(+ 1 (call/cc (lambda (k) (+ 2 (k 3)))))
で、プログラムの残りの部分というのは、call/cc
の適用の観点からは
次の「プログラムの穴」の部分( []
で穴を表現しています)です。
(+ 1 [])
いいかえれば、この継続はその穴を埋めるものがなんであれ、
それに 1
を加えるというプログラムです。
これは、call/cc
の引数ととともに呼び出されるものです。
call/cc
の引数は手続きであることを思い出してください。
(lambda (k) (+ 2 (k 3)))
この手続きの本体はその継続(この場合、パラメータ k
に束縛されている)を
引数 3
に適用します。継続の通常にはない局面が前面に
でてくるのはここです。継続の呼び出しはあっさりと自分の計算を捨て、
k
に格納されているプログラムの残りの部分と置き換えます。
いいかえれば、2
を加えるところを含む手続きの部分は捨てられ、
k
の引数 3
が「プログラムの穴」に直接、送りこまれます。
(+ 1 [])
このプログラムは単純に
(+ 1 3)
となり、4
が返ります。つまり、
(+ 1 (call/cc (lambda (k) (+ 2 (k 3))))) => 4
ということです。
上では、脱出継続を説明しています。これは、ある計算
(ここでは (+ 2 [])
の計算)から脱出するために用いられるものです。
これはたいへん使える性質をもちますが、Scheme の継続は以前に捨てた
文脈に戻るのにも使えます。実際、これを複数回呼びだすこともできます。
継続にまつられた「プログラムの残りの部分」は、いつでも、
何回でも呼び出して使うことができます。このことが、すばらしさに
貢献するとともにときには call/cc
の汎用性を分かりにくくしています。
ちょっとした例として、以下のようにリスナーにタイプしてみましょう。
(define r #f) (+ 1 (call/cc (lambda (k) (set! r k) (+ 2 (k 3))))) => 4
後の方の式は以前と同様に 4
を返します。この
call/cc
の使い方とその前の例での使い方の差は
ここでは、継続 k
をグローバル変数 r
に
保存しているということです。
いま、その継続の永続的な記録を r
のなかにとってあります。
もし、それを数値に対して呼べば、その数値を 1
増加させた
値が返ります。
(r 5) => 6
r
は自分自身の継続を捨ててしまうことに注意してください。
もっとうまく説明するには、いくつかの文脈内に、r
への
呼び出しをうめこんでみると分ります。
(+ 3 (r 5)) => 6
call/cc
で提供された継続はしたがって、実を結ばない継続です。
脱出継続は call/cc
の最もシンプルな使い方であり、
プログラミング手続きあるいはループ脱出にはたいへん便利です。
数値のリストをとりそれらを掛けあわせる手続き list-product
を
考えてみましょう。list-product
の直截的な再帰的定義は、以下の
とおりです。
(define list-product (lambda (s) (let recur ((s s)) (if (null? s) 1 (* (car s) (recur (cdr s)))))))
この解法には問題があります。リスト中の要素の一つが 0
で、
その 0
のあとにいくつもの要素があるとすると、答えは先に
わかってしまいます。しかし、このコードでは、答えを出すまでに
recur
への実りのない再帰呼び出しがいくつもつづきます。
こんなときに、脱出継続が便利です。call/cc
をつかうと
この手続きは次のように書き換えることができます。
(define list-product (lambda (s) (call/cc (lambda (exit) (let recur ((s s)) (if (null? s) 1 (if (= (car s) 0) (exit 0) (* (car s) (recur (cdr s))))))))))
もし、0
要素にであったら、継続 exit
が 0
とともに呼ばれて、
それ以上の recur
の呼び出しを回避します。
もっとこみいった継続の使用例は、二つのツリー (任意の入れ子状になったドット対)が同じ末端を持つかどうかを 決定する問題です。つまり、同じ要素(あるいは葉)を同じならびで もつかどうかを決定する問題です。たとえば、
(same-fringe? '(1 (2 3)) '((1 2) 3)) => #t (same-fringe? '(1 2 3) '(1 (3 2))) => #f
純粋な関数的アプローチは両方のツリーを平坦にして結果がマッチするか どうかを調べるというものです。
(define same-fringe? (lambda (tree1 tree2) (let loop ((ftree1 (flatten tree1)) (ftree2 (flatten tree2))) (cond ((and (null? ftree1) (null? ftree2)) #t) ((or (null? ftree1) (null? ftree2)) #f) ((eqv? (car ftree1) (car ftree2)) (loop (cdr ftree1) (cdr ftree2))) (else #f))))) (define flatten (lambda (tree) (cond ((null? tree) '()) ((pair? (car tree)) (append (flatten (car tree)) (flatten (cdr tree)))) (else (cons (car tree) (flatten (cdr tree)))))))
しかしながら、ツリーを平坦にするためにツリーを完全にトラバースすること
になり、また、マッチしない要素をがみつかるまで、また、トラバースします。
さらに、最高によい平坦化アルゴリズムでも、全体の葉の数と等しい cons
が
必要です。(破壊的に入力されたツリーを変更することはしません。)
この問題を不必要なトラバースなし、cons
なしで解決するのに
call/cc
を使うことができます。それぞれのツリーを生成器
つまり、ツリーの葉をツリーで出現した順に、左から右へ生成する
内部状態をともなう手続きにマップします。
(define tree->generator (lambda (tree) (let ((caller '*)) (letrec ((generate-leaves (lambda () (let loop ((tree tree)) (cond ((null? tree) 'skip) ((pair? tree) (loop (car tree)) (loop (cdr tree))) (else (call/cc (lambda (rest-of-tree) (set! generate-leaves (lambda () (rest-of-tree 'resume))) (caller tree)))))) (caller '())))) (lambda () (call/cc (lambda (k) (set! caller k) (generate-leaves))))))))
tree->generator
によってつくられる生成器が呼ばれると、その
呼び出しの継続を caller
に格納します。そうすると、葉を見つけた
時に誰にその葉を送ればよいか知ることが可能になります。
それから generate-leaves
というツリーを左から右へたどる
ループを回す内部手続きを呼びます。ループが葉にであったら、
caller
をつかって、その葉を生成器の結果として返します。
しかし、同時に generate-leaves
変数に、ループの残り
(call/cc
継続として捕捉されている)を格納することを覚えています。
次回にこの生成器が呼び出されたときには、このループは中断したところ
から再開し次の葉を探すことができます。
generate-leaves
が最後にやることは、空リストを caller
に
返すことであることに注意してください。空リストは正しい葉の値ではないので
これを、これ以上生成すべき葉がないことを知らせるのに使うことができます。
手続き same-fringe?
はそれぞれのツリー引数を生成器にマップし、
このふたつの生成器を交互に呼び出します。マッチしない葉が見つかった
とたんにマッチングが失敗したことが報されます。
(define same-fringe? (lambda (tree1 tree2) (let ((gen1 (tree->generator tree1)) (gen2 (tree->generator tree2))) (let loop () (let ((leaf1 (gen1)) (leaf2 (gen2))) (if (eqv? leaf1 leaf2) (if (null? leaf1) #t (loop)) #f))))))
ツリーは高々一度しかトラバースされず、ミスマッチが起こるときには
トラバースは一番左側のミスマッチのところまでであることは容易に
理解できますね。cons
は使われていません。
上で使用した生成器は手続き概念の興味深い一般化です。 生成器が呼び出されるたびに、その計算を再開し、呼び出し側に返すべき 結果があるときにはそれを返します。しかし、それは内部変数に継続を した後だけにおこるので、生成器はまた再開することが可能です。 この生成器を更に一般化することが可能です。 結果をお互いのあいだで送り返し、送り出すことで生成器は相互に 再開することが可能です。このような手続きのことをコルーチン [cite{coroutine}] と呼びます。
コルーチンをその本体に resume
の呼び出しを含めることが
できるような一引数の手続きと看倣します。resume
は二引数手続きで
コルーチンがもう一方のコルーチンを転送した値とともに再開するのに
使います。マクロ coroutine
は、コルーチンの初期引数の変数名と
本体をあたえるような手続きを定義しています。
(define-macro coroutine (lambda (x . body) `(letrec ((+local-control-state (lambda (,x) ,@body)) (resume (lambda (c v) (call/cc (lambda (k) (set! +local-control-state k) (c v)))))) (lambda (v) (+local-control-state v)))))
このマクロの呼び出しで、コルーチン手続きがひとつ
(これを A と呼びましょう)作成されます。これは、ひとつの
引数とともに呼びだすことができます。A は +local-control-state
という初期変数をもちます。この変数は、あらゆるところで、
このコルーチンの残りの計算を格納しておけるものです。最初は
このコルーチンの計算全体です。resume
が呼び出されると
(つまり、もう一方のコルーチン B が呼び出されると) 現在のコルーチンは
その +local-control-state
の値をのこりの計算へ更新し、そこで
停止します。それから、再開したコルーチン B にジャンプします。
コルーチン A 自身は、後のどこかのポイントで再開されると、計算は
+local-control-state
に格納された継続から進行します。
コルーチンを使うとツリーマッチングはずっとシンプルになります。 マッチング処理は、それぞれのツリーの葉を供給するふたつの別のコルーチン に依存するコルーチンとしてコーディングされます。
(define make-matcher-coroutine (lambda (tree-cor-1 tree-cor-2) (coroutine dont-need-an-init-arg (let loop () (let ((leaf1 (resume tree-cor-1 'get-a-leaf)) (leaf2 (resume tree-cor-2 'get-a-leaf))) (if (eqv? leaf1 leaf2) (if (null? leaf1) #t (loop)) #f))))))
葉の生成器コルーチンは、誰に葉を送ればよいかを記憶します。
(define make-leaf-gen-coroutine (lambda (tree matcher-cor) (coroutine dont-need-an-init-arg (let loop ((tree tree)) (cond ((null? tree) 'skip) ((pair? tree) (loop (car tree)) (loop (cdr tree))) (else (resume matcher-cor tree)))) (resume matcher-cor '()))))
こうなれば、
same-fringe?
手続きは、ほぼ次のように書くことができます。
(define same-fringe? (lambda (tree1 tree2) (letrec ((tree-cor-1 (make-leaf-gen-coroutine tree1 matcher-cor)) (tree-cor-2 (make-leaf-gen-coroutine tree2 matcher-cor)) (matcher-cor (make-matcher-coroutine tree-cor-1 tree-cor-2))) (matcher-cor 'start-ball-rolling))))
残念ながら、Scheme の letrec
がそれが導入したレキシカル変数間での
相互再帰的参照を解決することができるのは、それらの変数参照が、lambda
の内側にラップされた場合のみです。
(define same-fringe? (lambda (tree1 tree2) (letrec ((tree-cor-1 (make-leaf-gen-coroutine tree1 (lambda (v) (matcher-cor v)))) (tree-cor-2 (make-leaf-gen-coroutine tree2 (lambda (v) (matcher-cor v)))) (matcher-cor (make-matcher-coroutine (lambda (v) (tree-cor-1 v)) (lambda (v) (tree-cor-2 v))))) (matcher-cor 'start-ball-rolling))))
この same-fringe?
の書き換えでは、call/cc
は直接呼ばれることは
全くないことに注意してください。すべての継続のとりあつかいは
coroutine
マクロで処理されています。
1 もし、お使いの Scheme にこの略記が
なければ、(define call/cc call-with-current-continuation)
を
初期化コードのなかに入れておきましょう。反復性のストレス障害から
身をまもることができます。