今回は「継続渡しスタイル (Continuation Passing Style : CPS)」という手法について説明します。Scheme には「継続」という他の言語 [*1] にはない強力な機能がありますが、使いこなすのはちょっと難しいといわれています。継続渡しスタイルはクロージャを使った汎用的な方法で、クロージャがあるプログラミング言語であれば、継続渡しスタイルでプログラムを作成することができます。
最初に継続について簡単に説明します。継続は「次に行われる計算」のことです。たとえば、次のプログラムを例に考えてみましょう。
リスト : 逐次実行 (defn foo [] (println "foo")) (defn bar [] (println "bar")) (defn baz [] (println "baz")) (defn test [] (foo) (bar) (baz))
user=> (test) foo bar baz nil
関数 test は関数 foo, bar, baz を順番に呼び出します。foo の次に実行される処理は bar, baz の関数呼び出しです。この処理が foo を呼び出したあとの「継続」になります。同様に、bar のあとに実行されるのは baz の呼び出しで、この処理がこの時点での「継続」になります。
また、baz を呼び出したあと、test の中では次に実行する処理はありませんが、test は関数呼び出しされているので、関数呼び出しから元に戻る処理が baz を呼び出したあとの「継続」になります。
このように、あるプログラムを実行しているとき、そのプログラムを終了するまでには「次に実行する処理 (計算)」が必ず存在します。一般に、この処理 (計算) のことを「継続」といいます。
Scheme の場合、次の計算を続行するための情報を取り出して、それを保存することができます。Scheme では、この保存した情報を「継続」といって、通常のデータ型と同様に取り扱うことができます。
つまり、継続を変数に代入したり関数の引数に渡すことができるのです。継続を使うとプログラムの実行を途中で中断し、あとからそこに戻ってプログラムの実行を再開することができます。
一般のプログラミング言語では、Scheme のように継続を取り出して保存することはできません。そこで、継続 (次に行う処理) を関数 (クロージャ) で表して、それを引数に渡して実行することにします。これを「継続渡しスタイル (CPS)」といいます。次の例を見てください。
リスト : 継続渡しスタイル (defn test-cps [cont] (foo) (bar) (cont))
user=> (test-cps baz) foo bar baz nil
関数 test-cps は foo, bar を呼び出したあと、引数 cont に渡された処理 (継続) を実行します。関数 baz を渡せば foo, bar, baz と表示されますし、他の処理を渡せばそれを実行することができます。
もう一つ簡単な例を示しましょう。継続に値を渡して処理を行うこともできます。
user=> (defn add-cps [x y cont] (cont (+ x y))) #'user/add-cps user=> (add-cps 1 2 identity) 3 user=> (add-cps 1 2 println) 3 nil
関数 add-cps は引数 a と b を加算して、その結果を継続 cont に渡します。cont に identity を渡せば、計算結果を返すことができます。また、cont に println を渡せば、計算結果を表示することができます。
CPS を使うと再帰呼び出しを末尾再帰に変換することができます。たとえば、階乗の計算を CPS でプログラムすると次のようになります。
リスト : 階乗の計算 (CPS)
(defn fact-cps [n cont]
(if (zero? n)
(cont 1)
(recur (dec n) (fn [x] (cont (* n x))))))
引数 cont が継続を表します。n が 0 のときは、cont に階乗の値 1 を渡します。それ以外の場合は、階乗の計算を継続の処理にまかせて fact-cps を再帰呼び出し (recur) ます。ここで、fact-cps の呼び出しは末尾再帰になることに注意してください。
継続の処理 (fn [x] (cont (* n x))) では、継続の引数 x と fact-cps の引数 n を掛け算して、その結果を cont に渡します。たとえば、(fact-cps 3 identity) の呼び出しを図に示すと、次のようになります。
(fact 3 identity) ==> (fact 3 cont0) とする
=> (fact 2 (fn [x] (cont0 (* 3 x)))) ==> (fact 2 cont1) とする
=> (fact 1 (fn [x] (cont1 (* 2 x)))) ==> (fact 1 cont2) とする
=> (fact 0 (fn [x] (cont2 (* 1 x)))) ==> (fact 0 cont3) とする
=> (cont3 1)
継続の評価
(cont3 1)
=> ((fn [x] (cont2 (* 1 x))) 1)
=> (cont2 (* 1 1))
=> ((fn [x] (cont1 (* 2 x))) 1)
=> (cont1 (* 2 1))
=> ((fn [x] (cont0 (* 3 x))) 2)
=> (cont0 (* 3 2))
=> (identity 6)
=> 6
図 : fact-cps の実行
このように、継続の中で階乗の式が組み立てられていきます。そして、n が 0 のとき継続 cont に引数 1 を渡して評価すると、今まで組み立てられた式が評価されて階乗の値を求めることができます。つまり、n の階乗を求めるとき、継続を表す無名関数の引数 x には n - 1 の階乗の値が渡されていくわけです。そして、最後に継続 identity に n の階乗の値が渡されるので、階乗の値を返すことができます。
それでは実際に実行してみましょう。
user=> (dotimes [x 15] (fact-cps x println)) 1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800 479001600 6227020800 87178291200 nil
次はフィボナッチ数列を求める関数を CPS で作りましょう。次のリストを見てください。
リスト : フィボナッチ関数
;; 二重再帰
(defn fibo [n]
(if (< n 2)
n
(+ (fibo (dec n)) (fibo (- n 2)))))
;; CPS
(defn fibo-cps [n cont]
(if (< n 2)
(cont n)
(fibo-cps (dec n)
(fn [x]
(fibo-cps (- n 2) (fn [y] (cont (+ x y))))))))
関数 fibo-cps は、引数 n が 2 未満のとき cont n を評価します。それ以外の場合は fibo-cps を再帰呼び出しします。fibo-cps (dec n) が求まると、その値は継続の引数 x に渡されます。継続の中で、今度は fibo-cps (- n 2) の値を求めます。すると、その値は fibo-cps (- n 2) の継続の引数 y に渡されます。したがって、fibo-cps n の値は x + y で求めることができます。この値を fibo-cps n の継続 cont に渡せばいいわけです。
fibo-cps の実行を図に示すと、次のようになります。
f(5) ┬ f(4) ┬ f(3) ┬ f(2) ┬ f(1)
│ │ │ │
cont cont cont cont
│ │ │ └ f(0)
│ │ └ f(1)
│ └ f(2) ┬ f(1)
│ │
│ cont
│ └ f(0)
│
└ f(3) ┬ f(2) ┬ f(1)
│ │
cont cont
│ └ f(0)
└ f(1)
図 2 : fibo-cps の実行
cont は継続を表します。fibo-cps は末尾再帰になっているので、n - 1 の値を求めるために左から右へ処理が進みます。このとき、n - 2 の値を求める継続 cont が生成されていくことに注意してください。そして、f(1) の実行が終了すると継続が評価され、n - 2 の値が求められます。すると、2 番目の継続が評価されて n - 1 の値 x と n - 2 の値 y を加算して、その値を継続 cont に渡します。こうして、次々と継続が評価されてフィボナッチ関数の値を求めることができます。
それでは実際に実行してみましょう。
(dotimes [x 21] (println (fibo-cps x identity))) 0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 Execution error (StackOverflowError) at user/fibo-cps$fn (cps.clj:26). null
残念ながら、単純な二重再帰 (fibo) で求めることができる値でも、fibo-cps ではエラーになってしまいました。Clojure は末尾再帰最適化を行わないので、CPS との相性はあまりよくないようです。
ところで、fibo-cps は末尾再帰になっていますが、関数の呼び出し回数は二重再帰の場合と同じです。したがって、実行速度は二重再帰の場合とほとんどかわりません。また、二重再帰の場合は関数呼び出しによりスタックが消費されますが、CPS の場合はクロージャが生成されるのでメモリ (ヒープ領域) が消費されます。このように、再帰呼び出しを CPS に変換したからといって、効率の良いプログラムになるとは限りません。ご注意くださいませ。
階乗やフィボナッチ関数の場合、CPS に変換するメリットはほとんどありませんが、場合によっては CPS に変換した方が簡単にプログラムできることもあります。たとえば、リストを平坦化する関数 flatten で、リストの要素に空リストが含まれていたら空リストを返すようにプログラムすることを考えてみましょう。
まず最初に flatten について簡単に説明します。入れ子になっているリストの中から要素を取り出して、それを一つのリストにまとめます。これを「リストの平坦化」といいます。
リストの平坦化は、二重再帰を使うと簡単にプログラムできます。次のリストを見てください。
リスト : リストの平坦化
;; 空リストであれば真を返す、それ以外は偽を返す
(defn null? [x] (= x '()))
(defn flatten' [ls]
(cond
(null? ls) '()
(not (list? ls)) (list ls)
:else (concat (flatten' (first ls)) (flatten' (rest ls)))))
Clojure には flatten が定義されているので、名前を flatten' としました。ls が空リストであれば () を返します。述語 null? は Scheme から拝借しました。引数 ls がリストでなければ、それをリストに格納して返します。ls がリストの場合は、リストの先頭の要素を平坦化し、残りの要素を平坦化して、その結果を concat で結合します。
ここで、(concat () ls) と (concat ls ()) は ls になることに注意してください。したがって、リスト ls の要素に空リストがあっても、それが返り値のリストに含まれることはありません。
簡単な実行例を示しましょう。
user=> (flatten' '(a b (c d (e f) g) h)) (a b c d e f g h) user=> (flatten' '(a b (c d () (e f) g) h)) (a b c d e f g h)
2 番目の例のように、flatten' は空リストを取り除く動作になります。それでは、リストの要素に空リストがあれば、空リストを返すように flatten' を修正してみましょう。つまり、2 番目の例で flatten' の返り値は () になります。次のリストを見てください。
リスト : リストの平坦化の修正 (間違い)
(defn flatten'' [ls]
(cond
(null? ls) '()
(not (list? ls)) (list ls)
(null? (first ls)) '()
:else (concat (flatten'' (first ls)) (flatten'' (rest ls)))))
関数 flatten'' は (first ls) が空リストならば空リストを返していますが、これでは正常に動作しません。実際に試してみると次のようになります。
user=> (flatten'' '(a b (c d () (e f) g) h)) (a b c d h)
この場合、空リストを返したいのですが、その前の要素 c, d を連結したリストを返し、その後の処理も行っています。空リストを見つける前にリストの連結処理を行っているので、空リストを見つけたらその処理を廃棄し、その後の処理も行わないようにしないといけないのです。
このような場合、CPS を使うと途中で処理を終了することができます。次のリストを見てください。
リスト : リストの平坦化 (CPS)
(defn flatten-cps' [ls cont]
(cond
(null? ls) (cont '())
(not (list? ls)) (cont (list ls))
:else (flatten-cps'
(first ls)
(fn [y] (flatten-cps'
(rest ls)
(fn [z] (cont (concat y z))))))))
;;; flatten'' の CPS 化
(defn flatten-cps'' [ls cont]
(cond
(null? ls) (cont '())
(not (list? ls)) (cont (list ls))
(null? (first ls)) '()
:else (flatten-cps''
(first ls)
(fn [y] (flatten-cps''
(rest ls)
(fn [z] (cont (concat y z))))))))
flatten' を CPS に変換するのは簡単です。ls が空リストまたはアトムの場合は継続 cont を評価します。次に、flatten-cps' を再帰呼び出して (first ls) を平坦化します。その結果は継続の引数 y に渡されます。その継続の中で flatten-cps' を呼び出して (rest ls) を平坦化し、その結果を継続の引数 z に渡します。その中で (concat y z) を評価し、連結したリストを継続 cont に渡して評価すればいいわけです。
flatten-cps'' も簡単です。ls が空リストまたはアトムの場合は継続 cont を評価するところは同じです。もしも、リストの途中で空リストを見つけた場合は、空リストをそのまま返します。この場合、継続 cont は評価されないので、リストの連結処理は行われず、空リストをそのまま返すことができます。
それでは実行してみましょう。
user=> (flatten-cps' '(a b (c d () (e f) g) h) identity) (a b c d e f g h) user=> (flatten-cps'' '(a b (c d () (e f) g) h) identity) () user=> (flatten-cps'' '(a b (c d (e f) g) h) identity) (a b c d e f g h)
正常に動作していますね。まあ、実際のところ CPS 形式でプログラムを作るのは難しいので、Clojure であれば例外処理を使ったほうが簡単かもしれません。
次はリストを「木 (tree)」とみなして、木を巡回するプログラムを作ってみましょう。ここでは、コンスセルを節 (node) とし要素を葉 (leaf) と考えます。木を巡回するプログラムは簡単です。次のリストを見てください。
リスト : 木の巡回
(defn for-each-tree [func xs]
(cond
(null? xs) nil
(not (list? xs)) (func xs)
:else (do
(for-each-tree func (first xs))
(for-each-tree func (rest xs)))))
関数 for-each-tree は木 xs を巡回して、各要素に関数 func を適用します。for-each-tree は関数 func の副作用が目的なので、返り値に意味はありません。xs が () ならば何もせずに nil を返します。xs がコンスセルでなければ葉なので、xs に関数 func を適用します。あとは、xs を first と rest で分解して、for-each-tree を再帰呼び出しするだけです。
それでは実際に試してみましょう。
user=> (for-each-tree println '(a b (c d (e f) g) h)) a b c d e f g h nil
このプログラムを CPS に変換すると、次のようになります。
リスト : 木の巡回 (CPS)
(defn for-each-tree-cps [func xs cont]
(cond
(null? xs) (cont)
(not (list? xs)) (do (func xs) (cont))
:else
(for-each-tree-cps
func
(first xs)
(fn []
(for-each-tree-cps
func
(rest xs)
(fn [] (cont)))))))
for-each-tree-cps は副作用が目的なので、継続 cont に値を渡す必要はありません。xs が空リストの場合は cont を呼び出します。xs が葉の場合は func を適用してから cont を呼び出します。次に、for-each-tree-cps を再帰呼び出しして先頭要素の部分木をたどり、その継続の中で残りの部分木をたどります。そして、その継続の中で cont を呼び出します。これで生成された継続を呼び出して、木を巡回することができます。
それでは実際に試してみましょう。
user=> (for-each-tree-cps println '(a b (c d (e f) g) h) (fn [] nil)) a b c d e f g h nil
このように、木を巡回して各要素に関数 func を適用することができます。
木の巡回を CPS に変換すると、木から要素を順番に取り出す関数 (イテレータ) を簡単に作成することができます。次のリストを見てください。
リスト : 木の巡回 (イテレータ)
(defn for-each-tree-iter [xs cont]
(cond
(null? xs) (cont)
(not (list? xs)) (list xs cont)
:else
(for-each-tree-iter
(first xs)
(fn []
(for-each-tree-iter
(rest xs)
(fn [] (cont)))))))
for-each-tree-iter は木を巡回してその要素を順番に出力します。要素を返すとき、継続 cont もいっしょに返すところがポイントです。このように、CPS の継続を評価せずに関数の返り値として返すことで、プログラムの実行を一時的に中断することができます。そして、継続を評価することでプログラムの実行を再開し、次の要素を求めることができます。
なお、for-each-tree-iter を呼び出すときに渡す継続が一番最後に呼び出されるので、終端を表す値 (たとえば nil など) を返すようにプログラムしてください。
簡単な実行例を示しましょう。
user=> (def x (for-each-tree-iter '(a b (c d (e f) g) h) (fn [] nil))) #'user/x user=> (first x) a user=> (def x ((second x))) #'user/x user=> (first x) b user=> (def x ((second x))) #'user/x user=> (first x) c user=> (def x ((second x))) #'user/x user=> (first x) d user=> (def x ((second x))) #'user/x user=> (first x) e user=> (def x ((second x))) #'user/x user=> (first x) f user=> (def x ((second x))) #'user/x user=> (first x) g user=> (def x ((second x))) #'user/x user=> (first x) h user=> (def x ((second x))) #'user/x user=> (first x) nil
正常に動作していますね。このように、プログラムを CPS 形式で作ると、Scheme の継続とよく似た動作を行わせることができます。
プログラムを CPS に変換すると、遅延シーケンスに対応するのも簡単です。次のリストを見てください。
リスト : 木の巡回 (遅延ストリーム版)
(defn lazyseq-of-tree [ls cont]
(cond
(null? ls) (cont)
(not (list? ls)) (lazy-seq (cons ls (cont)))
:else
(lazyseq-of-tree
(first ls)
(fn []
(lazyseq-of-tree
(rest ls)
(fn [] (cont)))))))
lazyseq-of-tree は木を巡回してその要素を順番に出力する遅延シーケンスを生成します。lazyseq-of-tree は ls が葉の場合に lazy-seq で遅延ストリームを生成して返します。このとき、ls が遅延ストリームの要素になり、継続 cont の呼び出しをいっしょに格納します。この継続を評価することで、次の要素を求めることができます。
なお、lazyseq-of-tree を呼び出すときに渡す継続が一番最後に呼び出されるので、遅延ストリームの終端 NIL を返すように定義してください。
簡単な実行例を示しましょう。
user=> (def tree (lazyseq-of-tree '(a (b (c (d e) f) g) h) (fn [] nil))) #'user/tree user> tree (a b c d e f g h)
lazyseq-of-tree を使うと、2 つの木を比較する関数 same-fringe? を簡単に作ることができます。同じ葉を同じ並びで持つ場合、same-fringe? は true を返します。次の例を見てください。
(same-fringe? '(1 2 (3) 4) '(1 2 (3 4)) => true (same-fringe? '(1 2 (3) 4) '(1 2 (4) 3) => false
最初の例の場合、木の構造は違いますが、要素はどちらの木も 1, 2, 3, 4 の順番で並んでいるので、same-fringe? は true を返します。次の例では、木の構造は同じですが、 3 と 4 の順番が逆になっています。この場合、same-fringe? は false を返します。
プログラムは次のようになります。
リスト : ツリーマッチング
(defn same-fringe? [tree1 tree2]
(letfn [(iter [s1 s2]
(cond
(and (not (seq s1)) (not (seq s2))) true
(or (not (seq s1)) (not (seq s2))) false
(= (first s1) (first s2)) (iter (rest s1) (rest s2))
:else false))]
(iter (lazyseq-of-tree tree1 (fn [] nil))
(lazyseq-of-tree tree2 (fn [] nil)))))
実際の処理は局所関数 iter で行います。same-fringe-p は stream-of-tree で木の遅延ストリームを生成して iter に渡します。あとは、遅延ストリームから要素を一つずつ取り出して、それが等しいかチェックするだけです。
それでは実行例を示します。
user=> (same-fringe? '(1 2 (3 4 5 (6) 7) 8) '(1 2 (3 4 (5 6) 7) 8)) true user=> (same-fringe? '(1 2 (3 4 6 (5) 7) 8) '(1 2 (3 4 (5 6) 7) 8)) false
正常に動作していますね。
CPS は末尾再帰でプログラムしたほうが簡単ですが、Clojure は末尾再帰最適化を行わないので、fibo-cps のようにスタックオーバーフローすることがあります。この場合、クロージャを用いることで、末尾再帰を繰り返しのように実行する方法があります。末尾再帰の場合、再帰呼び出しのあとに行う処理は存在せず、関数の返り値をそのまま返すだけです。この返り値のかわりに、関数呼び出しの部分をクロージャに格納して返すこともできます。
ようするに、クロージャを使って遅延評価するわけです。ここで実行中の処理を中断することができます。そして、そのクロージャを評価すると、中断された処理を再開することができます。この場合、実行を再開するために必要な情報はクロージャに保存されます。
簡単な例を示しましょう。階乗を末尾再帰でプログラムすると次のようになります。
リスト : 階乗 (末尾再帰)
(defn facti
([n] (facti n 1))
([n a]
(if (zero? n)
a
(facti (dec n) (* a n)))))
facti は末尾で再帰呼び出しされているので末尾再帰になっています。facti の呼び出しをクロージャに格納すると、次のようになります。
リスト : 階乗 (末尾再帰)
(defn facti
([n] (facti n 1))
([n a]
(if (zero? n)
a
(fn [] (facti (dec n) (* a n))))))
これで n が 0 のときは a の値を返し、それ以外の場合はクロージャを返すようになります。クロージャの中には実行に必要な情報 n - 1 と a * n が保存されることに注意してください。たとえば、(facti 4 1) を実行すると n = 3, a = 4 を格納した手続きオブジェクトが返されます。
実際に値を求めるには、次の関数を使います。
リスト : クロージャを繰り返し実行する
(defn trcall [value]
(if (not (fn? value))
value
(recur (value))))
述語 fn? は引数が関数型データであれば真を返し、そうでなければ偽を返します。関数 trcall は引数 value が関数である間、それを評価し続けるだけです。value が関数でなければ、それをそのまま返します。
たとえば、(trcall (facti 4 1)) を実行すると、次のようになります。
(trcall (facti 4 1)) => (trcall (fn [] (facti 3 4)))
call => (fn [] (facti 2 12))
call => (fn [] (facti 1 24))
call => (fn [] (facti 0 24))
call => 24
図 : (trcall (facti 4 1)) の実行
このように、trcall の中で手続きオブジェクトを繰り返し呼び出すことで階乗の値を求めることができます。
それでは実際に試してみましょう。
user=> (dotimes [n 14] (println (trcall (facti n)))) 1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800 479001600 6227020800 nil
CPS も同じ方法で繰り返しのように実行することができます。fact-cps と fibo-cps をクロージャを使って書き直すと次のようになります。
リスト : fact-cps' と fibo-cps'
(defn fact-cps' [n cont]
(if (zero? n)
(cont 1)
(fn [] (fact-cps' (dec n) (fn [x] (cont (* n x)))))))
(defn fibo-cps' [n cont]
(if (< n 2)
(cont n)
(fn []
(fibo-cps'
(dec n)
(fn [x]
(fn [] (fibo-cps' (- n 2) (fn [y] (cont (+ x y))))))))))
fact-cps' と fibo-cps' の呼び出しを (fn [] ...) で囲むだけです。あとは trcall で値を求めるだけです。
簡単な実行例を示します。
user=> (dotimes [n 14] (println (trcall (fact-cps' n identity)))) 1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800 479001600 6227020800 nil user=> (dotimes [n 21] (println (trcall (fibo-cps' n identity)))) 0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 nil
fibo-cps' はスタックオーバーフローせずに値を求めることができました。ところで、クロージャのかわりに遅延評価 (delay) を使っても同じことができます。ご参考までに、delay を使ったプログラムを示します。
リスト : 遅延評価 (delay) を使う方法
(defn trcall' [value]
(if-not (instance? clojure.lang.Delay value)
value
(recur @value)))
(defn fact-cps'' [n cont]
(if (zero? n)
(cont 1)
(delay (fact-cps'' (dec n) (fn [x] (cont (* n x)))))))
(defn fibo-cps'' [n cont]
(if (< n 2)
(cont n)
(delay
(fibo-cps''
(dec n)
(fn [x]
(delay (fibo-cps'' (- n 2) (fn [y] (cont (+ x y))))))))))
実行結果は同じなので省略します。興味のある方はいろいろ試してみてください。
;;;
;;; cps.clj : 継続渡しスタイル (CPS)
;;;
;;; Copyright (C) 2025 Makoto Hiroi
;;;
;; 階乗の計算 (CPS)
(defn fact-cps [n cont]
(if (zero? n)
(cont 1)
(recur (dec n) (fn [x] (cont (* n x))))))
;; フィボナッチ関数
;; 二重再帰
(defn fibo [n]
(if (< n 2)
n
(+ (fibo (dec n)) (fibo (- n 2)))))
;; CPS
(defn fibo-cps [n cont]
(if (< n 2)
(cont n)
(fibo-cps (dec n)
(fn [x]
(fibo-cps (- n 2) (fn [y] (cont (+ x y))))))))
;; リストの平坦化
(defn null? [x] (= x '()))
(defn flatten' [ls]
(cond
(null? ls) '()
(not (list? ls)) (list ls)
:else (concat (flatten' (first ls)) (flatten' (rest ls)))))
(defn flatten'' [ls]
(cond
(null? ls) '()
(not (list? ls)) (list ls)
(null? (first ls)) '()
:else (concat (flatten'' (first ls)) (flatten'' (rest ls)))))
(defn flatten-cps' [ls cont]
(cond
(null? ls) (cont '())
(not (list? ls)) (cont (list ls))
:else (flatten-cps'
(first ls)
(fn [y] (flatten-cps'
(rest ls)
(fn [z] (cont (concat y z))))))))
;;; flatten'' の CPS 化
(defn flatten-cps'' [ls cont]
(cond
(null? ls) (cont '())
(not (list? ls)) (cont (list ls))
(null? (first ls)) '()
:else (flatten-cps''
(first ls)
(fn [y] (flatten-cps''
(rest ls)
(fn [z] (cont (concat y z))))))))
;; 木の巡回
(defn for-each-tree [func xs]
(cond
(null? xs) nil
(not (list? xs)) (func xs)
:else (do
(for-each-tree func (first xs))
(for-each-tree func (rest xs)))))
(defn for-each-tree-cps [func xs cont]
(cond
(null? xs) (cont)
(not (list? xs)) (do (func xs) (cont))
:else
(for-each-tree-cps
func
(first xs)
(fn []
(for-each-tree-cps
func
(rest xs)
(fn [] (cont)))))))
;; 木の巡回 (イテレータ)
(defn for-each-tree-iter [xs cont]
(cond
(null? xs) (cont)
(not (list? xs)) (list xs cont)
:else
(for-each-tree-iter
(first xs)
(fn []
(for-each-tree-iter
(rest xs)
(fn [] (cont)))))))
;; 遅延シーケンス
(defn lazyseq-of-tree [ls cont]
(cond
(null? ls) (cont)
(not (list? ls)) (lazy-seq (cons ls (cont)))
:else
(lazyseq-of-tree
(first ls)
(fn []
(lazyseq-of-tree
(rest ls)
(fn [] (cont)))))))
;; ツリーマッチング
(defn same-fringe? [tree1 tree2]
(letfn [(iter [s1 s2]
(cond
(and (not (seq s1)) (not (seq s2))) true
(or (not (seq s1)) (not (seq s2))) false
(= (first s1) (first s2)) (iter (rest s1) (rest s2))
:else false))]
(iter (lazyseq-of-tree tree1 (fn [] nil))
(lazyseq-of-tree tree2 (fn [] nil)))))
;; 末尾再帰を繰り返しに変換
(defn facti
([n] (facti n 1))
([n a]
(if (zero? n)
a
(fn [] (facti (dec n) (* a n))))))
(defn fact-cps' [n cont]
(if (zero? n)
(cont 1)
(fn [] (fact-cps' (dec n) (fn [x] (cont (* n x)))))))
(defn fibo-cps' [n cont]
(if (< n 2)
(cont n)
(fn []
(fibo-cps'
(dec n)
(fn [x]
(fn [] (fibo-cps' (- n 2) (fn [y] (cont (+ x y))))))))))
(defn trcall [value]
(if (not (fn? value))
value
(recur (value))))
;; 遅延評価 (delay) を使う方法
(defn trcall' [value]
(if-not (instance? clojure.lang.Delay value)
value
(recur @value)))
(defn fact-cps'' [n cont]
(if (zero? n)
(cont 1)
(delay (fact-cps'' (dec n) (fn [x] (cont (* n x)))))))
(defn fibo-cps'' [n cont]
(if (< n 2)
(cont n)
(delay
(fibo-cps''
(dec n)
(fn [x]
(delay (fibo-cps'' (- n 2) (fn [y] (cont (+ x y))))))))))