M.Hiroi's Home Page

Common Lisp Programming

お気楽 Common Lisp プログラミング入門

[ PrevPage | Common Lisp | NextPage ]

メモ化と遅延評価

今回は「たらいまわし関数」を例題にして「メモ化」と「遅延評価」について説明します。

●たらいまわし関数

最初に「たらいまわし関数」について説明します。次のリストを見てください。

リスト : たらいまわし関数

(defun tarai (x y z)
  (if (<= x y)
      y
    (tarai (tarai (1- x) y z) (tarai (1- y) z x) (tarai (1- z) x y))))

(defun tak (x y z)
  (if (<= x y)
      z
    (tak (tak (1- x) y z) (tak (1- y) z x) (tak (1- z) x y))))

関数 tarai や tak は「たらいまわし関数」といって、再帰的に定義されています。これらの関数は、引数の与え方によっては実行に時間がかかるため、Lisp などのベンチマークに利用されることがあります。

関数 tarai は通称「竹内関数」と呼ばれていて、日本の代表的な Lisper である竹内郁雄氏によって考案されたそうです。そして、関数 tak は関数 tarai のバリエーションで、John Macarthy 氏によって作成されたそうです。たらいまわし関数が Lisp のベンチマークで使われていたことは知っていましたが、このような由緒ある関数だとは思ってもいませんでした。

それでは、さっそく実行してみましょう。

tarai 14  7 0 : 6.47 [s]
tak   22 11 0 : 7.74 [s]

実行環境 : Ubunts 18.04 (Windows Subsystem for Linux), Intel Core i5-6200U 2.30GHz

このように、たらいまわし関数は引数の値が小さくても実行に時間がかかります。

●メモ化による高速化

たらいまわし関数が遅いのは、同じ値を何度も計算しているためです。この場合、表 (table) を使って処理を高速化することができます。同じ値を何度も計算することがないように、計算した値は表に格納しておいて、2 回目以降は表から計算結果を求めるようにします。このような手法を「表計算法」とか「メモ化 (memoization または memoisation)」といいます。

Common Lisp の場合、メモ化は ハッシュ表 を使うと簡単です。次のリストを見てください。

リスト : たらいまわし関数のメモ化 (1)

;;; メモ用のハッシュ表
(defvar *table* (make-hash-table :test #'equal))

(defun tarai-memo (x y z)
  (let* ((key (list x z y))
         (value (gethash key *table* nil)))
    (unless value
      (if (<= x y)
          (setf value y)
        (setf value (tarai-memo (tarai-memo (1- x) y z)
                                (tarai-memo (1- y) z x)
                                (tarai-memo (1- z) x y))))
      (setf (gethash key *table*) value))
    value))

関数 tarai-memo の値を格納するハッシュ表をスペシャル変数 *TABLE* に用意します。関数 tarai-memo では、引数 X, Y, Z を要素とするリストを作り、それをキーとしてハッシュ表 *TABLE* を検索します。*TABLE* に KEY があれば、その値 VALUE を返します。そうでなければ、値 VALUE を計算して *TABLE* にセットして、その値を返します。

ところで、ハッシュ表は局所変数に格納することもできます。次のリストを見てください。

リスト : たらいまわし関数のメモ化 (2)

(setf (symbol-function 'tak-memo)
      (let ((table (make-hash-table :test #'equal)))
        (labels
         ((tak (x y z)
               (let* ((key (list x y z))
                      (value (gethash key table nil)))
                 (unless value
                   (if (<= x y)
                       (setf value z)
                     (setf value (tak (tak (1- x) y z)
                                      (tak (1- y) z x)
                                      (tak (1- z) x y))))
                   (setf (gethash key table) value))
                 value)))
         #'tak)))

let でハッシュ表 TABLE を定義します。その中で labels を使ってたらいまわし関数 tak を局所関数として定義します。局所関数 tak の処理内容は tarai-memo と同じですが、X <= Y のときは Z を返します。最後に #'tak を返します。この返り値をシンボル TAK-MEMO の関数値にセットします。

拙作のページ 属性リスト で簡単に説明しましたが、Common Lisp のシンボルは自分自身の名前、関数値、変数値、属性リストを格納することができます。関数 symbol-function はシンボルから関数値を取り出すことができます。そして、setf と symbol-function を組み合わせると、シンボルに関数値をセットすることができます。

簡単な例を示しましょう。

* (setf (symbol-function 'square) (lambda (x) (* x x)))

#<FUNCTION (LAMBDA (X)) {1001BB002B}>
* (square 10)

100

シンボル SQUARE の関数値にラムダ式 (lambda (x) (* x x)) をセットします。すると、defun で関数を定義するのと同じように square を呼び出すことができます。ラムダ式は変数ではなくシンボルの関数値にセットされているので、funcall で呼び出す必要はありません。

なお、ハッシュ表が生成されるのは、TAK-MEMO に関数をセットするときの一回だけです。これで、その関数専用のハッシュ表を局所変数に用意することができます。

●メモ化関数

このように関数をメモ化することは簡単にできますが、メモ化を行うたびに関数を修正するのは面倒です。このような場合、関数をメモ化する「メモ化関数」があると便利です。メモ化関数については Structure and Interpretation of Computer Programs (SICP) 3.3.3 Representing Tables に詳しい説明があります。

プログラムは次のようになります。

リスト : メモ化関数

(defun memoize (func)
  (let ((table (make-hash-table :test #'equal)))
    (lambda (&rest args)
      (let ((value (gethash args table nil)))
        (unless value
          (setf value (apply func args))
          (setf (gethash args table) value))
        value))))

;;; 関数値を書き換える
(setf (symbol-function 'tak) (memoize #'tak))
(setf (symbol-function 'tarai) (memoize #'tarai))

関数 memoize は関数 FUNC を引数に受け取り、それをメモ化した関数を返します。memoize が返す関数はクロージャなので、memoize の引数 FUNC や局所変数 TABLE にアクセスすることができます。また、ラムダ式の引数 ARGS は可変個の引数を受け取るように定義します。これで複数の引数を持つ関数にも対応することができます。

ARGS の値は引数を格納したリストになるので、これをキーとして扱います。ハッシュ表 TABLE に値がなければ、関数 FUNC を呼び出して値を計算し、それを TABLE にセットします。そしで、最後に値を返します。

なお、シンボル TAK と TARAI の関数値を書き換えないと、関数 TAK, TARAI の中で再帰呼び出しするとき、メモ化した関数を呼び出すことができません。ご注意くださいませ。

それでは実際に実行してみましょう。

tarai (192, 96, 0) : 0.048 [s]
tak (192, 96, 0)   : 0.203 [s]

このように、引数の値を増やしても高速に実行することができます。メモ化の効果は十分に出ていると思います。また、同じ計算を再度実行すると、メモ化の働きにより値をすぐに求めることができます。

●遅延評価による高速化

関数 tarai は「遅延評価 (delayed evaluation または lazy evaluation)」を行う処理系、たとえば関数型言語の Haskell では高速に実行することができます。また、Scheme でも delay と force を使って遅延評価を行うことができます。tarai のプログラムを見てください。X <= Y のときに Y を返しますが、このとき引数 Z の値は必要ありませんね。引数 Z の値は X > Y のときに計算するようにすれば、無駄な計算を省略することができます。

なお、関数 tak は X <= Y のときに Z を返しているため、遅延評価で高速化することはできません。ご注意ください。

Common Lisp の場合、遅延評価は仕様 (ANSI Common Lisp) にはありませんが、クロージャを使って遅延評価を行うことは簡単です。今回は Shiro さんWiLiKi にある Scheme:たらいまわしべんち を参考に、プログラムを作ってみましょう。次のリストを見てください。

リスト : クロージャによる遅延評価

(defun tarai-lazy (x y z)
  (if (<= x y)
      y
    (let ((zz (funcall z)))
      (tarai-lazy (tarai-lazy (1- x) y  (lambda () zz))
                  (tarai-lazy (1- y) zz (lambda () x))
                  (lambda () (tarai-lazy (1- zz) x (lambda () y)))))))

遅延評価したい処理をクロージャに包んで引数 z に渡します。そして、x > y のときに引数 z の関数を呼び出します。すると、クロージャ内の処理が評価されて z の値を求めることができます。

たとえば、(lambda () 0) を z に渡す場合、(funcall z) とすると返り値は 0 になります。(lambda () x) を渡せば、x に格納されている値が返されます。(lambda () (tarai-lazy ...)) を渡せば、関数 tarai-lazy が実行されてその値が返されるわけです。

それでは、実際に実行してみましょう。実行環境は Windows XP, celeron 1.40 GHz, CLISP (version 2.44) です。

tarai 200 100 0
closure : 0.002 [s]

実行時間が速いので、今回は tarai 200 100 0 を 100 回実行した時間から 1 回の実行時間を求めました。tarai の場合、遅延評価の効果はとても大きいですね。

●delay と force の実装

ところで、Scheme の delay と force は Common Lisp でもマクロを使って簡単に実装することができます。次のリストを見てください。

リスト : delay と force

;;; プロミスの定義
(defstruct promise (result nil) thunk)

;;; プロミスの生成
(defmacro delay (expr)
  `(make-promise :thunk (lambda () ,expr)))

;;; プロミスの評価
(defun force (ps)
  (when (promise-thunk ps)
    (setf (promise-result ps) (funcall (promise-thunk ps))
          (promise-thunk  ps) nil))
  (promise-result ps))

delay はマクロで、引数 EXPR を評価しないで構造体 PROMISE を生成して返します。Scheme ではこれを「プロミス」といいます。本稿でもプロミスと呼ぶことにしましょう。EXPR はラムダ式に包んで PROMISE のスロット THUNK (サンク) にセットします。

関数 force は引数 PS にプロミスを受け取ります。スロット THUNK が真の場合、THUNK はまだ評価されていません。funcall で THUNK を評価して、その返り値をスロット RESULT にセットし、THUNK の値を NIL に書き換えます。THUNK が NIL ならば THUNK は評価済みなので何もしません。最後に RESULT を返します。

簡単な使用例を示しましょう。

* (setq a (delay (+ 10 20)))

#S(PROMISE :RESULT NIL :THUNK #<FUNCTION (LAMBDA ()) {1001BDEE7B}>)
* (force a)

30

(delay (+ 10 20)) の返り値を変数 a にセットします。このとき、S 式 (+ 10 20) は評価されていません。プロミスの値を実際に求める関数が force です。(force a) を評価すると、S 式 (+ 10 20) を評価して値 30 を返します。

また、プロミスは式の評価結果をキャッシュします。したがって、(force a) を再度実行すると、同じ式を再評価することなく値を求めることができます。次の例を見てください。

* (setq b (delay (progn (princ "oops!") (+ 10 20))))

#S(PROMISE :RESULT NIL :THUNK #<FUNCTION (LAMBDA ()) {1001BDEF0B}>)
* (force b)
oops!
30
* (force b)

30

最初に (force b) を実行すると、S 式 (progn (princ "oops!") (+ 10 20)) が評価されるので、画面に oops! が表示されます。次に、(force b) を実行すると、式を評価せずにキャッシュした値を返すので oops! は表示されません。

delay と force を使うと、tarai は次のようになります。

リスト : delay と force による遅延評価

(defun tarai (x y z)
  (if (<= x y)
      y
    (let ((zz (force z)))
      (tarai (tarai (1- x) y (delay zz))
             (tarai (1- y) zz (delay x))
             (delay (tarai (1- zz) x (delay y)))))))

関数 tarai の引数 Z にデータを渡すとき、delay でプロミスを生成します。そして、その値を取り出すときは (force z) とします。これで遅延評価を行うことができます。

それでは、実際に実行してみましょう。

tarai 200 100 0
PROMISE : 0.002 [s]

delay と force でも tarai を高速に実行することができました。遅延評価の効果は十分に出ていると思います。


初版 2008 年 11 月 2 日
改訂 2020 年 4 月 5 日

継続渡しスタイル

今回は「継続渡しスタイル (Continuation Passing Style : CPS)」という手法について説明します。Scheme には「継続」という他の言語 [*1] にはない強力な機能がありますが、使いこなすのはちょっと難しいといわれています。継続渡しスタイルはクロージャを使った汎用的な方法で、クロージャがあるプログラミング言語であれば、継続渡しスタイルでプログラムを作成することができます。

-- note --------
[*1] 実は Ruby にも「継続」があります。

●継続とは?

最初に継続について簡単に説明します。継続は「次に行われる計算」のことです。たとえば、次のプログラムを例に考えてみましょう。

リスト : 逐次実行

(defun foo () (print "foo"))
(defun bar () (print "bar"))
(defun baz () (print "baz"))

(defun test ()
  (foo) (bar) (baz))
* (test)

"foo"
"bar"
"baz"
"baz"

関数 test は関数 foo, bar, baz を順番に呼び出します。foo の次に実行される処理は bar, baz の関数呼び出しです。この処理が foo を呼び出したあとの「継続」になります。同様に、bar のあとに実行されるのは baz の呼び出しで、この処理がこの時点での「継続」になります。また、baz を呼び出したあと、test の中では次に実行する処理はありませんが、test は関数呼び出しされているので、関数呼び出しから元に戻る処理が baz を呼び出したあとの「継続」になります。

このように、あるプログラムを実行しているとき、そのプログラムを終了するまでには「次に実行する処理 (計算)」が必ず存在します。一般に、この処理 (計算) のことを「継続」といいます。Scheme の場合、次の計算を続行するための情報を取り出して、それを保存することができます。Scheme では、この保存した情報を「継続」といって、通常のデータ型と同様に取り扱うことができます。つまり、継続を変数に代入したり関数の引数に渡すことができるのです。継続を使うとプログラムの実行を途中で中断し、あとからそこに戻ってプログラムの実行を再開することができます。

●継続渡しスタイルとは?

一般のプログラミング言語では、Scheme のように継続を取り出して保存することはできません。そこで、継続 (次に行う処理) を関数 (クロージャ) で表して、それを引数に渡して実行することにします。これを「継続渡しスタイル (CPS)」といいます。次の例を見てください。

リスト : 継続渡しスタイル

(defun test-cps (cont)
  (foo) (bar) (funcall cont))
* (test-cps #'baz)

"foo"
"bar"
"baz"
"baz"

関数 test-cps は foo, bar を呼び出したあと、引数 cont に渡された処理 (継続) を実行します。関数 baz を渡せば foo, bar, baz と表示されますし、他の処理を渡せばそれを実行することができます。

もう一つ簡単な例を示しましょう。継続に値を渡して処理を行うこともできます。

* (defun add-cps (x y cont) (funcall cont (+ x y)))

ADD-CPS
* (add-cps 1 2 #'identity)

3
* (add-cps 1 2 #'print)

3
3

関数 add-cps は引数 A と B を加算して、その結果を継続 CONT に渡します。CONT に #'identity を渡せば、計算結果を返すことができます。また、CONT に #'print を渡せば、計算結果を表示することができます。

●再帰呼び出しと継続渡しスタイル

CPS を使うと再帰呼び出しを末尾再帰に変換することができます。たとえば、階乗の計算を CPS でプログラムすると次のようになります。

リスト : 階乗の計算 (CPS)

(defun fact-cps (n cont)
  (if (zerop n)
      (funcall cont 1)
    (fact-cps (1- n) (lambda (x) (funcall cont (* n x))))))

引数 CONT が継続を表します。N が 0 のときは、CONT に階乗の値 1 を渡します。それ以外の場合は、階乗の計算を継続の処理にまかせて fact-cps を再帰呼び出します。ここで、fact-cps の呼び出しは末尾再帰になることに注意してください。

継続の処理 (lambda (x) (funcall cont (* n x))) では、継続の引数 X と fact-cps の引数 N を掛け算して、その結果を CONT に渡します。たとえば、(fact-cps 3 #'identity) の呼び出しを図に示すと、次のようになります。

   (fact 3 #'identity) ==> (fact 3 cont0) とする
=> (fact 2 (lambda (x) (funcall cont0 (* 3 x)))) ==> (fact 2 cont1) とする
=> (fact 1 (lambda (x) (funcall cont1 (* 2 x)))) ==> (fact 1 cont2) とする
=> (fact 0 (lambda (x) (funcall cont2 (* 1 x)))) ==> (fact 0 cont3) とする
=> (funcall cont3 1)

継続の評価

(funcall cont3 1)
=> (funcall (lambda (x) (funcall cont2 (* 1 x)))) 1)
=> (funcall cont2 (* 1 1))
=> (funcall (lambda (x) (funcall cont1 (* 2 x)))) 1)
=> (funcall cont1 (* 2 1))
=> (funcall (lambda (x) (funcall cont0 (* 3 x)))) 2)
=> (funcall cont0 (* 3 2))
=> (funcall #'identity 6)
=> 6


                    図 1 : fact-cps の実行

このように、継続の中で階乗の式が組み立てられていきます。そして、N が 0 のとき継続 CONT に引数 1 を渡して評価すると、今まで組み立てられた式が評価されて階乗の値を求めることができます。つまり、N の階乗を求めるとき、継続を表すラムダ式の引数 x には N - 1 の階乗の値が渡されていくわけです。そして、最後に継続 #'identity に N の階乗の値が渡されるので、階乗の値を返すことができます。

それでは実際に実行してみましょう。

* (dotimes (x 15) (fact-cps x #'print))

1
1
2
6
24
120
720
5040
40320
362880
3628800
39916800
479001600
6227020800
87178291200
NIL

●二重再帰と継続渡しスタイル

次はフィボナッチ数列を求める関数を CPS で作りましょう。次のリストを見てください。

リスト : フィボナッチ関数

;;; 二重再帰
(defun fibo (n)
  (if (< n 2)
      n
    (+ (fibo (1- n)) (fibo (- n 2)))))

;;; CPS
(defun fibo-cps (n cont)
  (if (< n 2)
      (funcall cont n)
    (fibo-cps (1- n) (lambda (x)
                       (fibo-cps (- n 2) (lambda (y) (funcall cont (+ x y))))))))

関数 fibo-cps は、引数 N が 2 未満のとき CONT N を評価します。それ以外の場合は fibo-cps を再帰呼び出しします。fibo-cps (1- n) が求まると、その値は継続の引数 X に渡されます。継続の中で、今度は fibo-cps (- n 2) の値を求めます。すると、その値は fibo-cps (- n 2) の継続の引数 Y に渡されます。したがって、fibo-cps n の値は X + Y で求めることができます。この値を fibo-cps n の継続 cont に渡せばいいわけです。

fibo-cps の実行を図に示すと、次のようになります。

cont は継続を表します。fibo-cps は末尾再帰になっているので、n - 1 の値を求めるために左から右へ処理が進みます。このとき、n - 2 の値を求める継続 cont が生成されていくことに注意してください。そして、f(1) の実行が終了すると継続が評価され、n - 2 の値が求められます。すると、2 番目の継続が評価されて n - 1 の値 x と n - 2 の値 y を加算して、その値を継続 cont に渡します。こうして、次々と継続が評価されてフィボナッチ関数の値を求めることができます。

それでは実際に実行してみましょう。

* (dotimes (x 15) (fibo-cps x #'print))

0
1
1
2
3
5
8
13
21
34
55
89
144
233
377
NIL

正常に動作していますね。

ところで、fibo-cps は末尾再帰になっていますが、関数の呼び出し回数は二重再帰の場合と同じです。したがって、実行速度は二重再帰の場合とほとんどかわりません。また、二重再帰の場合は関数呼び出しによりスタックが消費されますが、CPS の場合はクロージャが生成されるのでメモリ (ヒープ領域) が消費されます。このように、再帰呼び出しを CPS に変換したからといって、効率の良いプログラムになるとは限りません。ご注意くださいませ。

●再帰呼び出しの中断

階乗やフィボナッチ関数の場合、CPS に変換するメリットはほとんどありませんが、場合によっては CPS に変換した方が簡単にプログラムできることもあります。たとえば、リストを平坦化する関数 flatten で、リストの要素に空リストが含まれていたら空リストを返すようにプログラムすることを考えてみましょう。

まず最初に flatten について簡単に説明します。入れ子になっているリストの中から要素を取り出して、それを一つのリストにまとめます。これを「リストの平坦化」といいます。

リストの平坦化は、二重再帰を使うと簡単にプログラムできます。次のリストを見てください。

リスト : リストの平坦化

(defun flatten (ls)
  (cond
   ((null ls) nil)
   ((atom ls) (list ls))
   (t (append (flatten (car ls)) (flatten (cdr ls))))))

引数のリスト LS が空リストであれば NIL を返します。LS がアトムであれば、それをリストに格納して返します。LS がリストの場合は、リストの先頭の要素を平坦化し、残りの要素を平坦化して、その結果を append で結合します。ここで、(append nil ls) と (append ls nil) は LS になることに注意してください。したがって、リスト LS の要素に空リストがあっても、それが返り値のリストに含まれることはありません。

簡単な実行例を示しましょう。

* (flatten '(a b (c d (e . f) g) h))

(A B C D E F G H)
* (flatten '(a b (c d () (e . f) g) h))

(A B C D E F G H)

2 番目の例のように、flatten は空リストを取り除く動作になります。それでは、リストの要素に空リストがあれば、空リストを返すように flatten を修正してみましょう。つまり、2 番目の例で flatten の返り値は NIL になります。次のリストを見てください。

リスト : リストの平坦化の修正 (間違い)

(defun flatten1 (ls)
  (cond
   ((null ls) nil)
   ((atom ls) (list ls))
   ((null (car ls)) nil)
   (t (append (flatten1 (car ls)) (flatten1 (cdr ls))))))

関数 flatten1 は (car ls) が空リストならば空リストを返していますが、これでは正常に動作しません。実際に試してみると次のようになります。

* (flatten1 '(a b (c d () (e . f) g) h))

(A B C D H)

この場合、空リストを返したいのですが、その前の要素 C, D を連結したリストを返し、その後の処理も行っています。空リストを見つける前にリストの連結処理を行っているので、空リストを見つけたらその処理を廃棄し、その後の処理も行わないようにしないといけないのです。

このような場合、CPS を使うと途中で処理を終了することができます。次のリストを見てください。

リスト : リストの平坦化 (CPS)

(defun flatten-cps (ls cont)
  (cond
   ((null ls) (funcall cont nil))
   ((atom ls) (funcall cont (list ls)))
   (t (flatten-cps (car ls)
                   (lambda (x)
                     (flatten-cps (cdr ls)
                       (lambda (y)
                         (funcall cont (append x y)))))))))

;;; flatten1 の CPS 化
(defun flatten-cps1 (ls cont)
  (cond
    ((null ls) (funcall cont nil))
    ((atom ls) (funcall cont (list ls)))
    ((null (car ls)) nil)
    (t (flatten-cps1 (car ls)
                     (lambda (x)
                       (flatten-cps1 (cdr ls)
                         (lambda (y)
                           (funcall cont (append x y)))))))))

flatten を CPS に変換するのは簡単です。LS が空リストまたはアトムの場合は継続 CONT を評価します。次に、flatten-cps を再帰呼び出して CAR 部のリストを平坦化します。その結果は継続の引数 X に渡されます。その継続の中で flatten-cps を呼び出して CDR 部のリストを平坦化し、その結果を継続の引数 Y に渡します。その中で (append x y) を評価し、連結したリストを継続 CONT に渡して評価すればいいわけです。

flatten-cps1 も簡単です。LS が空リストまたはアトムの場合は継続 CONT を評価するところは同じです。もしも、リストの途中で空リストを見つけた場合は、空リストをそのまま返します。この場合、継続 CONT は評価されないので、リストの連結処理は行われず、空リストをそのまま返すことができます。

それでは実行してみましょう。

* (flatten-cps '(a b (c d (e . f) g) h) #'identity)

(A B C D E F G H)
* (flatten-cps '(a b (c d () (e . f) g) h) #'identity)

(A B C D E F G H)
* (flatten-cps1 '(a b (c d (e . f) g) h) #'identity)

(A B C D E F G H)
* (flatten-cps1 '(a b (c d () (e . f) g) h) #'identity)

NIL

正常に動作していますね。まあ、実際のところ CPS 形式でプログラムを作るのは難しいので、Common Lisp であれば return-from や catch & throw を使った方が簡単でしょう。ご参考までに、return-from を使ったプログラムと実行例を示します。

リスト : リストの平坦化 (return-from で処理を中断する)

(defun flatten2 (ls)
  (labels
   ((flat (xs)
          (cond
           ((null xs) nil)
           ((atom xs) (list xs))
           ((null (car xs))
            (return-from flatten2))
           (t (append (flat (car xs)) (flat (cdr xs)))))))
   (flat ls)))
* (flatten2 '(a b (c d (e . f) g) h))

(A B C D E F G H)
* (flatten2 '(a b (c d () (e . f) g) h))

NIL

●CPS による木の巡回

次はリストを「木 (tree)」とみなして、木を巡回するプログラムを作ってみましょう。ここでは、コンスセルを節 (node) とし要素を葉 (leaf) と考えます。木を巡回するプログラムは簡単です。次のリストを見てください。

リスト : 木の巡回

(defun for-each-tree (fn xs)
  (cond
   ((null xs) nil)
   ((atom xs) (funcall fn xs))
   (t
    (for-each-tree fn (car xs))
    (for-each-tree fn (cdr xs)))))

関数 for-each-tree は木 XS を巡回して、各要素に関数 FN を適用します。for-each-tree は関数 FN の副作用が目的なので、返り値に意味はありません。XS が NIL ならば何もせずに NIL を返します。XS がコンスセルでなければ葉なので、XS に関数 FN を適用します。あとは、XS を car と cdr で分解して、for-each-tree を再帰呼び出しするだけです。

それでは実際に試してみましょう。

* (for-each-tree #'print '(a b (c d (e . f) g) h))

A
B
C
D
E
F
G
H
NIL

このプログラムを CPS に変換すると、次のようになります。

リスト : 木の巡回 (CPS)

(defun for-each-tree-cps (fn xs cont)
  (cond
   ((null xs) (funcall cont))
   ((atom xs)
    (funcall fn xs)
    (funcall cont))
   (t
    (for-each-tree-cps
     fn
     (car xs)
     (lambda ()
       (for-each-tree-cps
        fn
        (cdr xs)
        (lambda () (funcall cont))))))))

for-each-tree-cps は副作用が目的なので、継続 CONT に値を渡す必要はありません。XS が空リストの場合は CONT を呼び出します。XS が葉の場合は FN を適用してから CONT を呼び出します。次に、for-each-tree-cps を再帰呼び出しして先頭要素の部分木をたどり、その継続の中で残りの部分木をたどります。そして、その継続の中で CONT を呼び出します。これで生成された継続を呼び出して、木を巡回することができます。

それでは実際に試してみましょう。

* (for-each-tree-cps #'print '(a b (c d (e . f) g) h) (lambda () nil))

A
B
C
D
E
F
G
H
NIL

このように、木を巡回して各要素に関数 fn を適用することができます。

●CPS による継続の保存と実行の再開

木の巡回を CPS に変換すると、木から要素を順番に取り出す関数 (イテレータ) を簡単に作成することができます。次のリストを見てください。

リスト : 木の巡回 (イテレータ)

(defun for-each-tree-iter (xs cont)
  (cond
   ((null xs) (funcall cont))
   ((atom xs)
    (values xs cont))
   (t
    (for-each-tree-iter
     (car xs)
     (lambda ()
       (for-each-tree-iter
        (cdr xs)
        (lambda () (funcall cont))))))))

for-each-tree-iter は木を巡回してその要素を順番に出力します。要素を返すとき、継続 CONT もいっしょに返すところがポイントです。このように、CPS の継続を評価せずに関数の返り値として返すことで、プログラムの実行を一時的に中断することができます。そして、継続を評価することでプログラムの実行を再開し、次の要素を求めることができます。

なお、for-each-tree-gen を呼び出すときに渡す継続が一番最後に呼び出されるので、終端を表す値 (たとえば NIL など) を返すようにプログラムしてください。

簡単な実行例を示しましょう。

* (defvar a)

A
* (defvar b)

B
* (multiple-value-setq (a b) (for-each-tree-iter '(a (b (c d) e) f) (lambda () nil)))

A
* a

A
* b

#<CLOSURE (LAMBDA () :IN FOR-EACH-TREE-ITER) {1001E959FB}>
* (multiple-value-setq (a b) (funcall b))

B
* (multiple-value-setq (a b) (funcall b))

C
* (multiple-value-setq (a b) (funcall b))

D
* (multiple-value-setq (a b) (funcall b))

E
* (multiple-value-setq (a b) (funcall b))

F
* (multiple-value-setq (a b) (funcall b))

NIL
* b

NIL

正常に動作していますね。このように、プログラムを CPS 形式で作ると、Scheme の継続とよく似た動作を行わせることができます。


初版 2008 年 10 月 26 日
改訂 2020 年 4 月 5 日

Copyright (C) 2008-2020 Makoto Hiroi
All rights reserved.

[ PrevPage | Common Lisp | NextPage ]