今回は「継続渡しスタイル (Continuation Passing Style : CPS) 」という手法について説明します。Scheme には「継続」という他の言語 [*1] にはない強力な機能がありますが、使いこなすのはちょっと難しいといわれています。継続渡しスタイルはクロージャを使った汎用的な方法で、クロージャがあるプログラミング言語であれば、継続渡しスタイルでプログラムを作成することができます。
なお、このドキュメントは拙作のページ OCaml 入門: 継続渡しスタイル を Common Lisp 用に加筆・修正したものです。内容は重複していますが、ご了承くださいませ。
最初に継続について簡単に説明します。継続は「次に行われる計算」のことです。たとえば、次のプログラムを例に考えてみましょう。
リスト 1 : 逐次実行 (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) 」といいます。たとえば、次の例を見てください。
リスト 2 : 継続渡しスタイル (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 #'(lambda (x) (print x))) 3 3
関数 add-cps は引数 a と b を加算して、その結果を継続 cont に渡します。cont に #'identity [*2] を渡せば、計算結果を返すことができます。また、cont で print x を呼び出せば、計算結果を表示することができます。
CPS を使うと再帰呼び出しを末尾再帰に変換することができます。たとえば、階乗の計算を CPS でプログラムすると次のようになります。
リスト 3 : 階乗の計算 (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 #'(lambda (x) (print x)))) 1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800 479001600 6227020800 87178291200 NIL
次はフィボナッチ数列を求める関数を CPS で作りましょう。次のリストを見てください。
リスト 4 : フィボナッチ関数
; 二重再帰
(defun fibo (n)
(if (or (= n 0) (= n 1))
1
(+ (fibo (- n 1)) (fibo (- n 2)))))
; CPS
(defun fibo-cps (n cont)
(if (or (= n 0) (= n 1))
(funcall cont 1)
(fibo-cps (- n 1) #'(lambda (x)
(fibo-cps (- n 2) #'(lambda (y) (funcall cont (+ x y))))))))
関数 fibo-cps は、引数 n が 0 または 1 のとき cont 1 を評価します。それ以外の場合は fibo-cps を再帰呼び出しします。fibo-cps (n - 1) が求まると、その値は継続の引数 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 15) (fibo-cps x #'(lambda (x) (print x)))) 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 NIL
正常に動作していますね。
ところで、fibo-cps は末尾再帰になっていますが、関数の呼び出し回数は二重再帰の場合と同じです。したがって、実行速度は二重再帰の場合とほとんどかわりません。また、二重再帰の場合は関数呼び出しによりスタックが消費されますが、CPS の場合はクロージャが生成されるのでメモリ (ヒープ領域) が消費されます。このように、再帰呼び出しを CPS に変換したからといって、効率の良いプログラムになるとは限りません。ご注意くださいませ。
階乗やフィボナッチ関数の場合、CPS に変換するメリットはほとんどありませんが、場合によっては CPS に変換した方が簡単にプログラムできることもあります。たとえば、リストを平坦化する関数 flatten で、リストの要素に空リストが含まれていたら空リストを返すようにプログラムすることを考えてみましょう。
まず最初に flatten について簡単に説明します。入れ子になっているリストの中から要素を取り出して、それを一つのリストにまとめます。これを「リストの平坦化」といいます。
リストの平坦化は、二重再帰を使うと簡単にプログラムできます。次のリストを見てください。
リスト 5 : リストの平坦化
(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 になります。次のリストを見てください。
リスト 6 : リストの平坦化の修正 (間違い)
(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 を使うと簡単です。次のリストを見てください。
リスト 7 : リストの平坦化 (CPS)
; flatten の 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
正常に動作していますね。
関数型言語の場合、リスト操作関数の多くは高階関数として定義されています。Common Lisp にも便利な高階関数が多数用意されているので、それらを使いこなすとプログラムを簡単に作ることができるようになります。今回は Common Lisp の勉強として、よく使われるマッピング、フィルター、畳み込み (縮約) など、便利なリスト操作関数や高階関数を実際に作ってみましょう。
なお、このドキュメントは拙作のページ OCaml 入門: 高階関数 (2) を Common Lisp 用に加筆・修正したものです。内容は一部重複していますが、ご了承くださいませ。
リストの要素に関数 f を適用して、その結果をリストに格納して返す関数を「マップ関数 (mapping function) 」といいます。Common Lisp には mapcar や maplist など便利なマップ関数が用意されていますが、私達でも簡単にプログラムを作ることができます。次のリストを見てください。
リスト 8 : マップ関数 (1)
(defun map1 (fn ls)
(if (null ls)
nil
(cons (funcall fn (car ls))
(map1 fn (cdr ls)))))
(defun map2 (fn xs ys)
(if (or (null xs) (null ys))
nil
(cons (funcall fn (car xs) (car ys))
(map2 fn (cdr xs) (cdr ys)))))
(defun mapn (fn &rest args)
(if (member nil args)
nil
(cons (apply fn (map1 #'car args))
(apply #'mapn fn (map1 #'cdr args)))))
各関数の引数 fn はリストの要素に適用する関数です。map1 はリスト ls の要素に関数 fn を適用し、その結果をリストに格納して返します。map2 は二つのリスト xs, ys の要素に関数 fn を適用します。
mapn は 0 個以上のリストの要素に関数 fn を適用します。リストは引数 args に格納されています。各リストの要素は (map1 #'car args) で取り出すことができるので、この返り値に apply で fn を適用すればいいわけです。そして、(map1 #'cdr args) で各リストの先頭の要素を取り除き、apply で mapn を再帰呼び出しします。
簡単な実行例を示します。
> (map1 #'- '(1 2 3)) (-1 -2 -3) > (map2 #'+ '(1 2 3) '(4 5 6)) (5 7 9) > (mapn #'* '(1 2 3) '(4 5 6) '(7 8 9)) (28 80 162)
ところで、map1, map2, mapn は末尾再帰ではないので、長いリストに適用するとスタックがオーバーフローする危険性があります。ご参考までに、mapn を末尾再帰に変換した mapn1 と、それを繰り返しに変換した mapn2 を示します。
リスト 9 : マップ関数 (2)
; 末尾再帰
(defun mapn1 (fn &rest args)
(labels ((iter (fn a args)
(if (member nil args)
(nreverse a)
(iter fun
(cons (apply fn (map1 #'car args)) a)
(map1 #'cdr args)))))
(iter fn nil args)))
; 繰り返し
(defun mapn2 (fn &rest args)
(do ((ls args (map1 #'cdr ls))
(a nil))
((member nil ls) (nreverse a))
(push (apply fn (map1 #'car ls)) a)))
どちらの関数も累積変数 a のリストに関数 fn の返り値を格納し、nreverse でリスト a を逆順にして返します。末尾再帰最適化を行う Common Lisp 処理系では mapn1 でも問題ありませんが、どちらかといえば mapn2 のほうが Common Lisp らしいプログラムかもしれません。
フィルター (filter) はリストの要素に関数を適用し、関数が真を返す要素をリストに格納して返す関数です。関数 filter を再帰定義でプログラムすると次のようになります。
リスト 10 : フィルター (1)
(defun filter (pred ls)
(cond ((null ls) nil)
((funcall pred (car ls))
(cons (car ls) (filter pred (cdr ls))))
(t (filter pred (cdr ls)))))
引数 pred が述語で、ls がリストです。述語が真を返すとき要素を返り値のリストに追加し、偽を返すときはリストに加えません。簡単な実行例を示します。
> (filter #'evenp '(1 2 3 4 5 6)) (2 4 6) > (filter #'oddp '(1 2 3 4 5 6)) (1 3 5)
filter を末尾再帰と繰り返しで書き直すと次のようになります。
リスト 11 : フィルター (2)
(defun filter1 (pred ls)
(labels ((iter (pred ls a)
(cond ((null ls) (nreverse a))
((funcall pred (car ls))
(iter pred (cdr ls) (cons (car ls) a)))
(t (iter pred (cdr ls) a)))))
(iter pred ls nil)))
(defun filter2 (pred ls)
(let ((a nil))
(dolist (x ls (nreverse a))
(if (funcall pred x) (push x a)))))
マップ関数と同様に、どちらの関数も累積変数 a のリストに関数 fn の返り値を格納し、nreverse でリスト a を逆順にして返します。繰り返しは dolist を使って簡単にプログラムすることができます。
2 つの引数を取る関数 f とリストを引数に受け取る関数 reduce を考えます。reduce はリストの各要素に対して関数 f を図 3 のように適用します。
(1) (a1 a2 a3 a4 a5)
=> f( f( f( f( a1, a2 ), a3 ), a4 ), a5 )
(2) (a1 a2 a3 a4 a5)
=> f( a1, f( a2, f( a3, f( a4, a5 ) ) ) )
図 3 : 関数 reduce の動作
関数 f を適用する順番で 2 通りの方法があります。図 3 (1) はリストの先頭から f を適用し、図 3 (2) はリストの後ろから f を適用します。たとえば、関数 f が単純な加算関数とすると、reduce の結果はどちらの場合もリストの要素の和になります。
f(x, y) = x + y の場合 reduce => a1 + a2 + a3 + a4 + a5
このように、reduce はリストのすべての要素を関数 f を用いて結合します。このような操作を「縮約」とか「畳み込み」といいます。また、reduce の引数に初期値 g を指定することがあります。この場合、reduce は図 4 に示す動作になります。
(1) (a1 a2 a3 a4 a5)
=> f( f( f( f( f( g, a1 ), a2 ), a3 ), a4 ), a5 )
(2) (a1 a2 a3 a4 a5)
=> f( a1, f( a2, f( a3, f( a4, f( a5, g ) ) ) ) )
図 4 : reduce() の動作 (2)
ここでは簡単な例題として、図 4 (1) の動作を行う関数 fold-left と、図 4 (2) の動作を行う関数 fold-right を作ってみましょう。プログラムは次のようになります。
リスト 12 : 畳み込み
(defun fold-left (fn a ls)
(if (null ls)
a
(fold-left fn (funcall fn a (car ls)) (cdr ls))))
(defun fold-right (fn a ls)
(if (null ls)
a
(funcall fn (car ls) (fold-right fn a (cdr ls)))))
第 1 引数 fn が適用する関数、第 2 引数 a が初期値、第 3 引数 ls がリストです。最初の if が再帰呼び出しの停止条件ですが、ls に空リストが与えられた場合にも対応します。この場合は初期値 a を返します。そして、次の else 節でリストの要素を取り出して関数 fn を呼び出します。
たとえば、リストが (1 2 3) で a が 0 とします。最初は (funcall fn 0 1) が実行され、その返り値が fold-left の第 2 引数に渡されます。次は (funcall fn a 2) が実行されますが、これは fn(fn(0, 1), 2) と同じことです。そして、その結果が fold-left の第 2 引数になります。最後に (funcall fn a 3) が実行されますが、これは fn(fn(fn(0, 1), 2), 3) となり、図 4 (1) と同じ動作になります。
fold-left の場合、リストの要素が関数 fn の第 2 引数になり、第 1 引数にはこれまでの処理結果が渡されます。これに対し、fold-right の場合は逆になり、関数 fn の第 1 引数にリストの要素が渡されて、これまでの処理結果は第 2 引数に渡されます。これで図 4 (2) の動作を実現することができます。
簡単な実行例を示します。
> (fold-left #'+ 0 '(1 2 3 4 5)) 15 > (fold-right #'+ 0 '(1 2 3 4 5)) 15
fold-left と fold-right を繰り返しでプログラムすると次のようになります。
リスト 13 : 畳み込み (2)
(defun fold-left1 (fn a ls)
(let ((acc a))
(dolist (x ls acc)
(setf acc (funcall fn acc x)))))
(defun fold-right1 (fn a ls)
(let ((acc a))
(dolist (x (reverse ls) acc)
(setf acc (funcall fn x acc)))))
fold-left は末尾再帰になっているので繰り返しに変換するのは簡単です。累積変数 acc を用意し、その値を関数 fn の返り値で書き換えていくだけです。fold-right1 はリスト ls を reverse で反転することで繰り返しに変換しています。この場合、新しいリストを作ることになるので、残念ながら効率的なプログラムとはいえません。
ところで、fold-left, fold-right と 2 引数の関数を組み合わせると、いろいろな関数を実現することができます。最初に length の例を示します。
> (fold-left #'(lambda (x y) (1+ x)) 0 '(a b c d e f)) 6 > (fold-right #'(lambda (x y) (1+ y)) 0 '(a b c d e f)) 6
fold-left で length を実現する場合、初期値を 0 にして第 1 引数の値を +1 することで実現できます。fold-right の場合は第 2 引数の値を +1 します。
次に map の例を示します。
> (fold-right #'(lambda (x y) (cons (* x x) y)) nil '(1 2 3 4 5)) (1 4 9 16 25)
map の場合は fold-rigth を使うと簡単です。初期値を nil にして第 1 引数の計算結果を第 2 引数のリストに追加するだけです。
次に filter の例を示します。
> (fold-right #'(lambda (x y) (if (evenp x) (cons x y) y)) nil '(1 2 3 4 5)) (2 4)
filter の場合も初期値を nil にして、第 1 引数が条件を満たしていれば第 2 引数のリストに追加します。
最後に述語が真となる要素の個数を求めてみましょう。これは Common Lisp の関数 count-if と同じです。
> (fold-right #'(lambda (x y) (if (evenp x) (1+ y) y)) 0 '(1 2 3 4 5)) 2
このように、畳み込みを使っていろいろな処理を実現することができます。
ところで、今まで説明したリスト操作は次のように一般化することができます。
リスト 14 : リスト操作の一般化
(defun for-each-list (fn comb term ls)
(if (null ls)
term
(funcall comb
(funcall fn (car ls))
(for-each-list fn comb term (cdr ls)))))
関数 for-each-list の引数 fn はリストの要素に適用する関数、comb は CAR 部と CDR 部を結合する関数、term はリストの終端で返す値です。プログラムは簡単で、引数のリスト ls が空リストならば term を返します。そうでなければ、リストの要素に関数 fn を適用し、その返り値と for-each-list の返り値を関数 comb で結合します。
たとえば、map1, filter, fold-right を for-each-list を使ってプログラムすると、次のようになります。
リスト 15 : for-each-list の使用例
; マッピング
(defun map1 (fn ls)
(for-each-list fn #'cons nil ls))
; フィルター
(defun filter (fn ls)
(for-each-list #'(lambda (x) (if (funcall fn x) (list x))) #'append nil ls))
; 畳み込み
(defun fold-right (fn a ls)
(for-each-list #'identity
#'(lambda (x y) (funcall fn x y))
a
ls))
map1 は comb に cons を、term に nil を渡せば実現できます。filter はリストの要素 x に関数 fn を適用し、真を返す場合は (list x) を返し、偽の場合は nil を返します。それを append で連結すると、nil はリストの要素に含まれないので、filter として動作します。fold-right も簡単です。identity でリストの要素をそのまま返し、要素を連結する関数の中で fn を呼び出します。これで畳み込みを行うことができます。
簡単な実行例を示します。
> (map1 #'(lambda (x) (* x x)) '(1 2 3 4 5)) (1 4 9 16 25) > (filter #'(lambda (x) (oddp x)) '(1 2 3 4 5)) (1 3 5) > (fold-right #'+ 0 '(1 2 3 4 5)) 15 > (fold-right #'cons nil '(1 2 3 4 5)) (1 2 3 4 5)
ところで、for-each-list を末尾再帰や繰り返しに変換すると次のようになります。
リスト 16 : リスト操作の一般化 (2)
; 末尾再帰
(defun for-each-list1 (fn comb term ls)
(labels ((iter (ls a)
(if (null ls)
a
(iter (cdr ls) (funcall comb (funcall fn (car ls)) a)))))
(iter ls term)))
; 繰り返し
(defun for-each-list2 (fn comb term ls)
(let ((a term))
(dolist (x ls a)
(setf a (funcall comb (funcall fn x) a)))))
この場合、リストの先頭から関数 fn を適用していくので、map1 や filter を実現する場合は nreverse で返り値のリストを反転してください。また、fold-left は簡単に実現できますが、fold-right は引数のリスト ls を reverse で反転する必要があります。ご注意くださいませ。
for-each-list は関数 fn にリストの要素を渡していますが、リストそのものを渡すこともできます。このほうが便利な場合もあります。次のリストを見てください。
リスト 17 : リスト操作の一般化 (3)
(defun for-each-list (fn comb term ls)
(if (null ls)
term
(funcall comb
(funcall fn ls)
(for-each-list fn comb term (cdr ls)))))
この場合、for-each-list の動作は次のようになります。
> (for-each-list #'identity #'cons nil '(a b c d e)) ((A B C D E) (B C D E) (C D E) (D E) (E))
このように、Common Lisp の関数 maplist と同じ動作になります。マップ関数、フィルター、畳み込みなどの高階関数は、for-each-list を使って次のように定義することができます。
リスト 18 : for-each-list の使用例 ; マッピング (defun mapcar-1 (fn ls) (for-each-list #'(lambda (xs) (funcall fn (car xs))) #'cons nil ls)) (defun maplist-1 (fn ls) (for-each-list fn #'cons nil ls)) (defun mapcan-1 (fn ls) (for-each-list #'(lambda (xs) (funcall fn (car xs))) #'nconc nil ls)) (defun mapcon-1 (fn ls) (for-each-list fn #'nconc nil ls)) ; フィルター (defun filter-1 (fn ls) (for-each-list #'car #'(lambda (x a) (if (funcall fn x) (cons x a) a)) nil ls)) ; 畳み込み (defun fold-right (fn a ls) (for-each-list #'car #'(lambda (x a) (funcall fn x a)) a ls))
簡単な実行例を示しましょう。
> (mapcar-1 #'(lambda (x) (cons x x)) '(a b c d e)) ((A . A) (B . B) (C . C) (D . D) (E . E)) > (maplist-1 #'(lambda (x) (cons (car x) (length x))) '(a b c d e)) ((A . 5) (B . 4) (C . 3) (D . 2) (E . 1)) > (mapcan-1 #'(lambda (x) (list x)) '(a b c d e)) (A B C D E) > (mapcon-1 #'(lambda (x) (copy-list x)) '(a b c d e)) (A B C D E B C D E C D E D E E) > (filter-1 #'evenp '(1 2 3 4 5 6)) (2 4 6) > (fold-right #'+ 0 '(1 2 3 4 5 6)) 21
もう一つ簡単な例を示しましょう。リストから重複した要素を取り除く関数 remove-dup は、for-each-list を使って次のように定義することができます。
リスト : 重複した要素を取り除く (defun remove-dup (ls) (for-each-list #'identity #'(lambda (xs a) (if (member (car xs) (cdr xs)) a (cons (car xs) a))) nil ls))
実行例を示します。
> (remove-dup '(a a b a b c a b c d a b c d e)) (A B C D E)