今回は「多重継承」について説明します。実をいうと、M.Hiroi は多重継承に対してあまりいいイメージを持っていません。私見ですが、多重継承はメリットよりもプログラムを複雑にするデメリットの方が大きいのではないか、と思っています。とくに、下図のクラス A, B, C, E のような菱形の関係をＣ++でプログラムする場合、とても複雑な問題を引き起こすことが知られています。
Ａ
／ ＼
／ ＼
Ｂ Ｃ
＼ ／
＼ ／
Ｄ
図 1 : 多重継承
CLOS の多重継承はクラスの優先順位が明確に定められているので、Ｃ++よりも扱いやすいと思います。しかしながら、CLOS の多重継承にも問題点があります。多重継承は強力な機能ですが万能ではありません。多重継承は慎重に扱うべきだと思っています。
それでは最初に多重継承の基本について説明します。
簡単な例題として、2 つのクラス foo と bar を継承するクラス baz を考えてみましょう。次のリストを見てください。
リスト 1 : 多重継承 ; クラス foo の定義 (defclass foo () ((a :accessor foo-a :initform 1 :initarg :a))) ; メソッド (defmethod method-1 ((x foo)) (print "foo method")) ; クラス bar の定義 (defclass bar () ((b :accessor bar-b :initform 2 :initarg :b))) ; メソッド (defmethod method-1 ((x bar)) (print "bar method")) ; クラス baz の定義 (defclass baz (bar foo) ())
クラス foo にはスロット a とアクセスメソッド foo-a が、クラス bar にはスロット b とアクセスメソッド bar-b が定義されています。そして、両方のクラスともメソッド method-1 が定義されています。
クラス baz で foo と bar を継承する場合、スーパークラスのリストに foo と bar をセットするだけです。これで foo と bar を継承することができます。さっそく実行してみましょう。
> (setq z (make-instance 'baz)) #<BAZ #x1A707B59> > (foo-a z) 1 > (bar-b z) 2 > (typep x 'baz) T > (typep x 'foo) T > (typep x 'bar) T > (method-1 z) "foo method" "foo method"
クラス baz にはスーパークラスから継承したスロット a, b と、アクセスメソッド foo-a, bar-b があります。baz のインスタンス z に foo-a を適用するとスロット a にアクセスし、bar-b を適用するとスロット b にアクセスすることができます。それから、多重継承の場合でもデータ型は継承されます。クラス baz のインスタンスはデータ型が baz になりますが、クラス foo と bar を継承しているので、typep は foo でも bar でも真 (T) を返します。
それでは、両方のクラスに定義されている method-1 はどちらが評価されるのでしょう。"foo method" と表示されたので、クラス foo のメソッドが評価されたことがわかります。このように、メソッドの探索はスーパークラスを格納するリストの先頭から順番（左から右）に行われ、最初に見つかったメソッドが適用されます。これを「左優先則」といいます。したがって、スーパークラスの順番を逆にすると、次のように "bar method" と表示されます。
(defclass baz (bar foo) ())
> (setq z (make-instance 'baz)) #<BAZ #x1A707B61> > (method-1 z) "bar method" "bar method"
では、foo と bar にスーパークラスが設定されている場合はどうなるのでしょうか。この場合、メソッドは「深さ優先」で探索されます。次の図を見てください。
Ａ Ｂ Ｃ
│ │ │
│ │ │
Ｄ Ｅ Ｆ
＼ │ ／
＼│／
Ｇ
Ｇ→Ｄ→Ａ→Ｅ→Ｂ→Ｆ→Ｃ
図 2 : 多重継承のメソッドの探索 (1)
クラス G は、クラス D, E, F を多重継承しています。D, E, F のスーパークラスはそれぞれ A, B, C です。クラス G でスーパークラスのリストが (D E F) であれば、最初にクラス D のメソッドを探索します。次は深さ優先で探索するので、クラス E ではなくクラス A を探索します。
このように、スーパークラスを優先して探索し、それでも見つからないときはクラス E を探索します。したがって、探索順序は「G → D → A → E → B → F → C」となるのです。上図を経路と考えれば、まさに深さ優先探索そのものですね。これを「深さ優先則」といいます。
では、次の場合はどうなるのでしょうか。
Ａ
／ ＼
／ ＼
Ｂ Ｃ Ｄ→Ｂ→Ｃ→Ａ
＼ ／
＼ ／
Ｄ
図 3 : 多重継承のメソッドの探索 (2)
あるクラスからスーパークラスをたどり、複数の経路で到達できるクラスを「合流点」といいます。上図の場合、クラス A は D - B - A と D - C - A という 2 つの経路があるので合流点になります。メソッドの探索で合流点にぶつかると、そこで探索を中断して次の経路を探索します。そして、最後の経路で合流点に到達したら、それ以降のスーパークラスを探索します。したがって、上図の探索順序は「D → B → C → A」となります。これを「合流則」といいます。
それでは実際に試してみましょう。
; クラスの定義 (defclass foo-a () ()) (defclass foo-b (foo-a) ()) (defclass foo-c (foo-a) ()) (defclass foo-d (foo-b foo-c) ()) ; メソッドの定義 (defmethod method-2 ((x foo-a)) (print "foo-a method")) (defmethod method-2 ((x foo-c)) (print "foo-c method"))
> (setq z (make-instance 'foo-d)) #<FOO-D #x1A70992D> > (method-2 z) "foo-c method" "foo-c method"
4 つのクラス foo-a, foo-b, foo-c, foo-d とメソッド method-2 を定義します。method-2 はクラス foo-a と foo-c に定義します。クラス foo-a が合流点であることに注意してください。クラス foo-d のインスタンスを生成してメソッド method-2 を呼び出すと、"foo-c method" と表示されますね。foo-a のメソッドではなく、foo-c のメソッドが適用されたことがわかります。
このように CLOS は「適用可能なメソッド」を探索するのですが、実際にはもっと複雑な処理を行っています。CLOS の場合、適用可能なメソッドとは「クラス優先順位リスト」と呼ばれるものの中で、一番最初にその引数特定子があらわれるものになります。
たとえば、クラス foo-a, foo-b, foo-c, foo-d の優先順位リストは (foo-d foo-b foo-c foo-a) になります。これは、次のようにメソッド method-3 で call-next-method を適用することで確認できます。
; メソッドの定義 (defmethod method-3 ((x foo-a)) (print "foo-a method")) (defmethod method-3 ((x foo-b)) (print "foo-b method") (call-next-method)) (defmethod method-3 ((x foo-c)) (print "foo-c method") (call-next-method)) (defmethod method-3 ((x foo-d)) (print "foo-d method") (call-next-method))
> (setq x (make-instance 'foo-d)) #<FOO-D #x1A70AAF1> > (method-3 x) "foo-d method" "foo-b method" "foo-c method" "foo-a method" "foo-a method"
このように、優先順位はリストの先頭の foo-d がいちばん高く、最後の foo-a がいちばん低くなります。ここで、メソッド method-2 の引数特定子は foo-c と foo-a がありますが、foo-c の優先順位が高いので引数特定子 foo-c のメソッドが適用されます。
CLOS の場合、このクラス優先順位を決めるアルゴリズムがとても複雑なのですが、たいていの場合は今まで説明した次の 3 つの規則を適用した結果と同じになります。
複雑な継承関係でなければ、これらの規則で十分理解できると思います。クラス優先順位リストを決定するアルゴリズムは 参考文献 [1] の付録で詳しく説明されています。興味のある方はお読みくださいませ。
継承 で説明したように、CLOS は defclass でスロットを定義するときに、スーパークラスと同じスロット名があってもかまいません。ただし、インスタンス内では、同じスロット名でアクセスできるスロットはひとつしか存在しません。これは多重継承でも同じです。次の例を見てください。
; クラスの定義 (defclass foo () ((a :accessor foo-a :initform 1 :initarg :a))) (defclass bar () ((a :accessor bar-a :initform 2 :initarg :b))) (defclass baz (foo bar) ())
> (setq z (make-instance 'baz)) #<BAZ #x1A709849> > (foo-a z) 1 > (bar-a z) 1 > (setq z1 (make-instance 'baz :b 100)) #<BAZ #x1A717595> > (foo-a z1) 100 > (bar-a z1) 100
クラス foo はスロット a を定義しています。クラス bar にも同じ名前のスロット a があります。そして、クラス baz は foo と bar を継承しています。この場合、baz のインスタンスを生成すると、a に対応するスロットはひとつしかありません。このとき、スロットオプションも継承されることに注意してください。
:accessor で指定されたメソッド foo-a, bar-a はどちらも利用することができます。この場合、同じスロット a をアクセスすることになります。:initform は「クラス優先順位リスト」と同じ規則で決定されます。この場合、左優先則でクラス foo の値が優先されます。したがって、(make-instance 'baz) とすると、スロット a の初期値は 1 になります。実際に、メソッド foo-a, bar-a で値を求めると、1 に初期化されていることがわかります。
:initarg はどちらのキーワードでも利用可能です。この場合も同じスロットに初期値を与えることになります。foo で指定したキーワード :a でも bar で指定した :b でも、スロット a の初期値を与えることができます。
ところで、多重継承を使う場合、異なる性質や機能を持つクラスを継承することがあります。たとえば、クラス foo にはメソッド method-a があり、クラス bar にはメソッド method-b があるとしましょう。この 2 つのメソッドはまったく異なる働きをします。ここで、メソッド method-a はスロット x を使っていて、method-b もスロット x を使っていると、多重継承で問題が発生します。
クラス foo と bar を多重継承してクラス baz を作成した場合、クラス baz のインスタンスにはスロット x がひとつしかありません。メソッド method-a と method-b はひとつしかないスロット x を使うことになります。この場合、どちらかのメソッドは正常に動作しないでしょう。これでは多重継承する意味がありませんね。これが CLOS における多重継承の問題点です。
このように、多重継承はどんなクラスでもできるというわけではありません。同名のスロットを持つクラスは多重継承できないと考えた方がよいでしょう。それから、多重継承にはもうひとつ問題点があります。それはクラスの階層構造が複雑になることです。
単一継承の場合、クラスの階層は木構造になりますが、多重継承ではグラフになります。木構造の場合、クラスの優先順位は簡単にわかりますが、グラフになると優先順位を理解するのは難しくなります。多重継承は強力な機能ですが、使うときには十分な注意が必要なのです。
これらの問題を回避するため、スロット (属性) を継承するスーパークラスはひとつだけに限定して、あとのスーパークラスはメソッド (実装) だけを継承するという方法があります。この方法を Mix-in といいます。
具体的には、スロットを定義せずにメソッドだけを記述したクラスを用意します。属性の継承は単一継承になりますが、実装のみを記述したクラスはいくつ継承してかまいません。ひとつのクラスに複数の実装を混ぜることから Mix-in と呼ばれています。
なお、Mix-in は特別な機能ではなく、多重継承を使いこなすための方法論にすぎません。多重継承を扱うことができるプログラミング言語であれば Mix-in を行うことが可能です。なお、もともと Mix-in は Flavors という Lisp にあるオブジェクト指向機能です。CLOS は Flavors の影響を強く受けています。ちなみに、Mix-in を言語仕様に取り込んだのが Ruby です。
CLOS は多重継承をサポートしているので、Mix-in を利用することができます。図 4 を見てください。
Ａ
／
Ｂ
Mixin A ／ ＼ Mixin B
＼ ／ ＼ ／
Ｃ Ｄ
図 4 : Mix-in
クラス C はクラス B を継承していて、そこにクラス Mixin A が Mix-in されています。クラス D もクラス B を継承していますが、Mix-in されているクラスは Mixin B となります。
多重継承の問題点は Mix-in ですべて解決できるわけではありませんが、クラスの階層構造がすっきりとしてわかりやすくなることは間違いありません。Mix-in は多重継承を使いこなす優れた方法だと思います。
それでは Mix-in の例題として、クラス enumerable を作ってみましょう。enumerable は dlist のような複数のデータを格納するクラス (コレクションクラス) に高階関数 (メソッド) を Mix-in します。これは Ruby のモジュール (Mix-in 用のクラス) Enumerable を参考にしました。追加するメソッドを表 1 に示します。
| 名前 | 機能 |
|---|---|
| enum-find obj func | func が真となる要素を返す |
| enum-position obj func | func が真となる要素の位置を返す |
| enum-count obj func | func が真となる要素の個数を返す |
| enum-map obj func | 要素に func を適用した結果をリストに格納して返す |
| enum-filter obj func | func が真となる要素をリストに格納して返す |
なお、これらのメソッドは enumerable を Mix-in するクラスのメソッド enum-fold を呼び出して動作します。なお、畳み込みを使わずにイテレータを使う方法もあります。これは後で実際に試してみましょう。プログラムは次のようになります。
リスト 2 : Mix-in 用のクラス enumerable
; enumerable 用
(defmethod enum-fold ((d dlist) func init &key from-end)
(dlist-fold d func init :from-end from-end))
; クラス定義
(defclass enumerable () ())
; 述語 pred が真となる要素を返す
(defmethod enum-find ((e enumerable) pred)
(enum-fold e
#'(lambda (n x)
(if (funcall pred x)
(return-from enum-find x)
(1+ n)))
0)
nil)
; 述語 pred が真となる要素の位置を返す
(defmethod enum-position ((e enumerable) pred)
(enum-fold e
#'(lambda (n x)
(if (funcall pred x)
(return-from enum-position n)
(1+ n)))
0)
nil)
; 述語 pred が真となる要素の個数を返す
(defmethod enum-count ((e enumerable) pred)
(enum-fold e
#'(lambda (n x)
(if (funcall pred x) (1+ n) n))
0))
; マッピング
(defmethod enum-map ((e enumerable) func)
(enum-fold e
#'(lambda (x a) (cons (funcall func x) a))
nil
:from-end t))
; フィルター
(defmethod enum-filter ((e enumerable) pred)
(enum-fold e
#'(lambda (x a)
(if (funcall pred x) (cons x a) a))
nil
:from-end t))
クラス enumerable は Mix-in を前提としているので、スロットの定義は不要でメソッドだけを定義します。要素のアクセスは enum-fold で行います。enum-fold は Mix-in するクラスで定義されているものとします。つまり、enum-fold を定義さえすれば、どんなクラスでも enumberable を Mix-in することができるわけです。dlist の enum-fold は dlist-fold を呼び出すだけです。
Common Lisp の場合、defmethod は defun と同様に、関数の本体を暗黙のうちに block method-name で囲みます。したがって、return-from method-name value で、メソッドの返り値として value を返すことができます。これは enum-fold が呼び出すラムダ式内であってもかまいません。retrun-from のタグ名の探索はレキシカルスコープで行われるので、そのラムダ式がメソッド内で定義されていれば正常に動作します。
それでは、dlist と enumerable を継承したクラス enum-dlist を作って、実際に試してみましょう。
> (defclass enum-dlist (dlist enumerable) ()) #<STANDARD-CLASS ENUM-DLIST> > (setq a (make-instance 'enum-dlist)) #<dlist: NIL> > (dotimes (x 5) (dlist-insert a -1 x)) NIL > a #<dlist: (0 1 2 3 4)> > (enum-find a #'evenp) 0 > (enum-find a #'oddp) 1 > (enum-position a #'(lambda (x) (< 5 x))) NIL > (enum-position a #'(lambda (x) (< 2 x))) 3 > (enum-count a #'evenp) 3 > (enum-count a #'oddp) 2 > (enum-map a #'(lambda (x) (* x x))) (0 1 4 9 16) > (enum-filter a #'evenp) (0 2 4) > (enum-filter a #'oddp) (1 3)
正常に動作していますね。複数のクラスで共通の操作 (メソッド) を定義したい場合、Mix-in はとても役に立ちます。
ところで、dlist が enumerable を継承すれば、dlist のインスタンスに enumerable のメソッドを適用することができます。この場合、dlist を継承するクラス、たとえば fixed-dlist は enumerable を Mix-in しなくても enumerable のメソッドを利用することができます。dlist が enumerable を継承しない場合、fixed-list で enumerable を Mix-in すれば、fixed-list で enumerable のメソッドを利用することができます。
enumerable はメソッド enum-fold を呼び出すことで動作しますが、畳み込みのかわりにイテレータを使う方法もあります。Gauche (Scheme) のコレクションクラス <collection> を参考にプログラムを作ってみましょう。
Gauche のコレクションクラスは複数のデータを格納するデータ構造を表す抽象クラスです。<collection> を継承 (Mix-in) することで、<collection> のメソッドを利用できるようになります。このとき、基本となるメソッドが call-with-iterator です。
call-with-iterator collection proc [opts]
call-with-iterator は高段関数 (メソッド) で、関数 proc には 2 つの関数が渡されて呼び出されます。第 1 引数はコレクションの終了判定を行う関数、第 2 引数はコレクションの要素を順番に取り出す関数 (イテレータ) です。どちらの関数も引数はありません。proc はこれらの関数を使ってコレクションの要素を取り出して、適切な処理を行います。
Common Lisp で双方向リスト用の call-with-iterator をプログラムすると次のようになります。
リスト : 双方向リスト用のイテレータ
(defmethod call-with-iterator ((d dlist) proc &key from-end)
(let* ((next (if from-end #'cell-prev #'cell-next))
(cp (funcall next (dlist-top d))))
(funcall
proc
#'(lambda () (eq cp (dlist-top d)))
#'(lambda ()
(if (eq cp (dlist-top d))
nil
(prog1
(cell-item cp)
(setq cp (funcall next cp))))))))
どちらの関数もクロージャを使って実装します。第 1 引数に渡す終了判定用の関数は簡単ですね。第 2 引数に渡すイテレータは、変数 cp の要素を cell-item で取り出して、その後 cp の値を次のセルに更新します。これで、イテレータを呼び出すたびに、双方向リストの要素を順番に取り出していくことができます。なお、call-with-iterator はパッケージ dlist の非公開メソッドを呼び出しているので、パッケージ dlist 内で定義してください。
call-with-iterator を使って enumerable を書き直すと、次のようになります。
リスト : Mix-in 用クラス (イテレータバージョン)
; Mix-in 用クラスの定義
(defclass enumerable1 () ())
; 述語 pred が真となる要素を返す
(defmethod enum-find ((e enumerable1) pred)
(call-with-iterator
e
#'(lambda (endp next)
(loop
(if (funcall endp)
(return)
(let ((x (funcall next)))
(if (funcall pred x) (return x))))))))
; 述語 pred が真となる要素の位置を返す
(defmethod enum-position ((e enumerable1) pred)
(call-with-iterator
e
#'(lambda (endp next)
(do ((n 0))
((funcall endp) nil)
(if (funcall pred (funcall next))
(return n)
(incf n))))))
; 述語 pred が真となる要素の個数を返す
(defmethod enum-count ((e enumerable1) pred)
(call-with-iterator
e
#'(lambda (endp next)
(do ((n 0))
((funcall endp) n)
(if (funcall pred (funcall next)) (incf n))))))
; マッピング
(defmethod enum-map ((e enumerable1) func)
(call-with-iterator
e
#'(lambda (endp next)
(do ((a nil))
((funcall endp) a)
(push (funcall func (funcall next)) a)))
:from-end t))
; フィルター
(defmethod enum-filter ((e enumerable1) func)
(call-with-iterator
e
#'(lambda (endp next)
(do ((a nil))
((funcall endp) a)
(let ((x (funcall next)))
(if (funcall func x) (push x a)))))
:from-end t))
; 畳み込み
(defmethod enum-fold ((e enumerable1) func init &key from-end)
(call-with-iterator
e
#'(lambda (endp next)
(do ((a init))
((funcall endp) a)
(setq a (if from-end
(funcall func (funcall next) a)
(funcall func a (funcall next))))))
:from-end from-end))
endp で enumberable1 を継承したコレクションの終端をチェックし、next でその要素を取り出していくだけのなで、とくに難しいところはないと思います。簡単な実行例を示します。
> (defclass enum-dlist1 (dlist enumerable1) ()) #<STANDARD-CLASS ENUM-DLIST1> > (setq a (make-instance 'enum-dlist1)) #<dlist: NIL> > (dotimes (x 8) (dlist-insert a -1 (1+ x))) NIL > a #<dlist: (1 2 3 4 5 6 7 8)> > (enum-find a #'evenp) 2 > (enum-find a #'oddp) 1 > (enum-position a #'evenp) 1 > (enum-position a #'oddp) 0 > (enum-count a #'evenp) 4 > (enum-map a #'(lambda (x) (* x x))) (1 4 9 16 25 36 49 64) > (enum-filter a #'evenp) (2 4 6 8) > (enum-fold a #'(lambda (a x) (cons x a)) nil) (8 7 6 5 4 3 2 1) > (enum-fold a #'(lambda (x a) (cons x a)) nil :from-end t) (1 2 3 4 5 6 7 8)
正常に動作していますね。双方向リストの場合、畳み込みとイテレータどちらの方法でも Mix-in を簡単に実現することができます。このほかにも、いくつかの方法が考えられますが、本ページの範囲を超えるので割愛いたします。Gauche のユーザリファレンス 9.3 gauche.collection - コレクションフレームワーク にわかりやすい説明があるので、興味のある方はお読みください。
;
; dlist.l : 双方向リスト
;
; Copyright (C) 2010 Makoto Hiroi
;
; 修正 2010/09/19
;
; 1. パッケージ名を "DLIST" に変更
; 2. defpackage に (:use "COMMON-LISP") を追加
; 3. :export の指定を文字列に変更
;
(provide "DLIST")
(defpackage "DLIST"
(:use "COMMON-LISP")
(:export "DLIST" "DLIST-REF" "DLIST-SET" "DLIST-INSERT" "DLIST-DELETE"
"DLIST-FOLD" "DLIST-LENGTH" "DLIST-CLEAR" "DLIST-EMPTYP"
"LIST-TO-DLIST" "DLIST-TO-LIST" "DLIST-FOR-EACH" "PRINT-OBJECT"
))
(in-package "DLIST")
; メソッドの宣言
(defgeneric dlist-ref (d n))
(defgeneric dlist-set (d n value))
(defgeneric dlist-insert (d n value))
(defgeneric dlist-delete (d n))
(defgeneric dlist-fold (d func init &key from-end))
(defgeneric dlist-length (d))
(defgeneric dlist-clear (d))
(defgeneric dlist-emptyp (d))
(defgeneric list-to-dlist (ls))
(defgeneric dlist-to-list (d))
(defgeneric dlist-for-each (d func &key from-end))
;;; セルの定義
(defclass cell ()
((item :accessor cell-item :initform nil :initarg :item)
(next :accessor cell-next :initform nil :initarg :next)
(prev :accessor cell-prev :initform nil :initarg :prev)))
; 空リストの生成
(defun make-empty ()
(let ((cp (make-instance 'cell)))
(setf (cell-next cp) cp
(cell-prev cp) cp)
cp))
;;; 双方向リストクラスの定義
(defclass dlist ()
((top :accessor dlist-top :initform (make-empty))))
; n 番目のセルを求める (操作用関数)
(defun cell-nth (d n next)
(do ((i -1 (1+ i))
(cp (dlist-top d) (funcall next cp)))
((= i n) cp)
(if (and (<= 0 i) (eq (dlist-top d) cp))
(error "cell-nth --- oops!"))))
; 参照
(defmethod dlist-ref ((d dlist) (n integer))
(cell-item
(if (minusp n)
(cell-nth d (abs (1+ n)) #'cell-prev)
(cell-nth d n #'cell-next))))
; 書き換え
(defmethod dlist-set ((d dlist) (n integer) value)
(setf (cell-item (if (minusp n)
(cell-nth d (abs (1+ n)) #'cell-prev)
(cell-nth d n #'cell-next)))
value))
; 挿入
(defmethod dlist-insert ((d dlist) (n integer) value)
(labels ((cell-insert (n next)
(let* ((p (cell-nth d (- n 1) next))
(q (funcall next p))
(cp (make-instance 'cell :item value)))
(if (eq #'cell-next next)
(setf (cell-next cp) q
(cell-prev cp) p
(cell-prev q) cp
(cell-next p) cp)
(setf (cell-prev cp) q
(cell-next cp) p
(cell-next q) cp
(cell-prev p) cp)))))
(if (minusp n)
(cell-insert (abs (1+ n)) #'cell-prev)
(cell-insert n #'cell-next))))
; 削除
(defmethod dlist-delete ((d dlist) (n integer))
(labels ((cell-delete (n next prev)
(let* ((cp (cell-nth d n next))
(p (funcall prev cp))
(q (funcall next cp)))
(if (eq next #'cell-next)
(setf (cell-next p) q
(cell-prev q) p)
(setf (cell-prev p) q
(cell-next q) p))
(cell-item cp))))
(if (minusp n)
(cell-delete (abs (1+ n)) #'cell-prev #'cell-next)
(cell-delete n #'cell-next #'cell-prev))))
; 畳み込み
(defmethod dlist-fold ((d dlist) func init &key from-end)
(let ((next (if from-end #'cell-prev #'cell-next)))
(do ((cp (funcall next (dlist-top d)) (funcall next cp))
(a init))
((eq cp (dlist-top d)) a)
(setq a (if (eq next #'cell-prev)
(funcall func (cell-item cp) a)
(funcall func a (cell-item cp)))))))
; サイズ
(defmethod dlist-length ((d dlist))
(dlist-fold d #'(lambda (x y) (1+ x)) 0))
; クリア
(defmethod dlist-clear ((d dlist))
(let ((cp (dlist-top d)))
(setf (cell-next cp) cp
(cell-prev cp) cp)))
; 空リストか？
(defmethod dlist-emptyp ((d dlist))
(let ((cp (dlist-top d)))
(eq cp (cell-next cp))))
; リストを双方向リストに変換
(defmethod list-to-dlist ((xs list))
(let ((d (make-instance 'dlist)))
(dolist (x xs d)
(dlist-insert d -1 x))))
; 双方向リストをリストに変換
(defmethod dlist-to-list ((d dlist))
(dlist-fold d
#'(lambda (x y) (cons x y))
nil
:from-end t))
; 巡回
(defmethod dlist-for-each ((d dlist) func &key from-end)
(if from-end
(dlist-fold d #'(lambda (x y) (funcall func x)) nil :from-end t)
(dlist-fold d #'(lambda (x y) (funcall func y)) nil)))
; 表示
(defmethod print-object ((x dlist) stream)
(format stream "#<dlist: ~S>" (dlist-to-list x)))
; イテレータ
(defmethod call-with-iterator ((d dlist) proc &key from-end)
(let* ((next (if from-end #'cell-prev #'cell-next))
(cp (funcall next (dlist-top d))))
(funcall
proc
#'(lambda () (eq cp (dlist-top d)))
#'(lambda ()
(if (eq cp (dlist-top d))
nil
(prog1
(cell-item cp)
(setq cp (funcall next cp))))))))
;
; dlist2.l : 双方向リスト
;
; Copyright (C) 2010 Makoto Hiroi
;
(require :dlist "dlist") ; 修正 2010/09/19
(use-package :dlist) ; パッケージ名をキーワードで指定
;;; Mix-in 用 畳み込みバージョン
; enumerable 用
(defmethod enum-fold ((d dlist) func init &key from-end)
(dlist-fold d func init :from-end from-end))
; クラス定義
(defclass enumerable () ())
; 述語 pred が真となる要素を返す
(defmethod enum-find ((e enumerable) pred)
(enum-fold e
#'(lambda (n x)
(if (funcall pred x)
(return-from enum-find x)
(1+ n)))
0)
nil)
; 述語 pred が真となる要素の位置を返す
(defmethod enum-position ((e enumerable) pred)
(enum-fold e
#'(lambda (n x)
(if (funcall pred x)
(return-from enum-position n)
(1+ n)))
0)
nil)
; 述語 pred が真となる要素の個数を求める
(defmethod enum-count ((e enumerable) pred)
(enum-fold e
#'(lambda (n x)
(if (funcall pred x) (1+ n) n))
0))
; マッピング
(defmethod enum-map ((e enumerable) func)
(enum-fold e
#'(lambda (x a) (cons (funcall func x) a))
nil
:from-end t))
; フィルター
(defmethod enum-filter ((e enumerable) pred)
(enum-fold e
#'(lambda (x a)
(if (funcall pred x) (cons x a) a))
nil
:from-end t))
;;; Mix-in イテレータバージョン
; クラス定義
(defclass enumerable1 () ())
; メソッドの宣言
(defgeneric call-with-iterator (e f &key from-end))
; 述語 pred が真となる要素を返す
(defmethod enum-find ((e enumerable1) pred)
(call-with-iterator
e
#'(lambda (endp next)
(loop
(if (funcall endp)
(return)
(let ((x (funcall next)))
(if (funcall pred x) (return x))))))))
; 述語 pred が真となる要素の位置を返す
(defmethod enum-position ((e enumerable1) pred)
(call-with-iterator
e
#'(lambda (endp next)
(do ((n 0))
((funcall endp) nil)
(if (funcall pred (funcall next))
(return n)
(incf n))))))
; 述語 pred が真となる要素の個数を返す
(defmethod enum-count ((e enumerable1) pred)
(call-with-iterator
e
#'(lambda (endp next)
(do ((n 0))
((funcall endp) n)
(if (funcall pred (funcall next)) (incf n))))))
; マッピング
(defmethod enum-map ((e enumerable1) func)
(call-with-iterator
e
#'(lambda (endp next)
(do ((a nil))
((funcall endp) a)
(push (funcall func (funcall next)) a)))
:from-end t))
; フィルター
(defmethod enum-filter ((e enumerable1) func)
(call-with-iterator
e
#'(lambda (endp next)
(do ((a nil))
((funcall endp) a)
(let ((x (funcall next)))
(if (funcall func x) (push x a)))))
:from-end t))
; 畳み込み
(defmethod enum-fold ((e enumerable1) func init &key from-end)
(call-with-iterator
e
#'(lambda (endp next)
(do ((a init))
((funcall endp) a)
(setq a (if from-end
(funcall func (funcall next) a)
(funcall func a (funcall next))))))
:from-end from-end))