今回は「多重継承」について説明します。実をいうと、M.Hiroi は多重継承に対してあまりいいイメージを持っていません。私見ですが、多重継承はメリットよりもプログラムを複雑にするデメリットの方が大きいのではないか、と思っています。とくに、下図のクラス A, B, C, E のような菱形の関係をＣ++でプログラムする場合、とても複雑な問題を引き起こすことが知られています。
Ａ
／ ＼
／ ＼
Ｂ Ｃ
＼ ／
＼ ／
Ｄ
図 1 : 多重継承
CLOS や Gauche の多重継承はクラスの優先順位が明確に定められているので、Ｃ++よりも扱いやすいと思います。しかしながら、CLOS や Gauche でも多重継承で問題が発生することもあります。多重継承は強力な機能ですが万能ではありません。多重継承は慎重に扱うべきだと思っています。
簡単な例題として、2 つのクラス <foo> と <bar> を継承するクラス <baz> を考えてみましょう。次のリストを見てください。
リスト 1 : 多重継承 ; <foo> の定義 (define-class <foo> () ((a :accessor foo-a :init-value 1 :init-keyword :a))) ; <foo> のメソッド (define-method method-foo ((x <foo>)) (print "foo!")) (define-method method-a ((x <foo>)) (print "foo method-a")) ; <bar> の定義 (define-class <bar> () ((b :accessor bar-b :init-value 2 :init-keyword :b))) ; <bar> のメソッド (define-method method-bar ((x <bar>)) (print "bar!")) (define-method method-a ((x <bar>)) (print "bar method-a")) ; <baz> の定義 (define-class <baz> (<foo> <bar>) ())
クラス <foo> にはスロット a とメソッド foo-a, method-foo が、クラス <bar> にはスロット b とメソッド bar-b, method-bar が定義されています。そして、両方のクラスともメソッド method-a が定義されています。
クラス <baz> で <foo> と <bar> を多重継承する場合、スーパークラスを指定するリストに <foo> と <bar> をセットするだけです。これで <foo> と <bar> を継承することができます。さっそく実行してみましょう。
gosh> (define a (make <baz>)) a gosh> a #<<baz> 0pb72480> gosh> (foo-a a) 1 gosh> (bar-b a) 2 gosh> (method-foo a) foo! #<undef> gosh> (method-bar a) bar! #<undef> gosh> (is-a? a <foo>) #t gosh> (is-a? a <bar>) #t gosh> (is-a? a <baz>) #t
クラス <baz> にはスーパークラスから継承したスロット a と b があり、メソッドは foo-a, method-foo, bar-b, method-bar の 4 つがあります。<baz> のインスタンス a に foo-a を適用するとスロット a にアクセスし、bar-b を適用するとスロット b にアクセスすることができます。当然ですが、メソッド method-foo と method-bar も呼び出すことができます。
それから、多重継承の場合でもデータ型は継承されます。クラス <baz> のインスタンス a は (is-a? a <baz>) を評価すると #t を返しますが、クラス <foo> と <bar> を継承しているので、is-a? は <foo> でも <bar> でも #t を返します。
それでは、両方のクラスに定義されている method-a はどちらが評価されるのでしょうか。実際に実行してみましょう。
gosh> (method-a a) foo method-a #<undef>
foo method-a と表示されたので、クラス <foo> の method-a が評価されたことがわかります。このように、メソッドの探索はスーパークラスを格納するリストの先頭から順番 (左から右) に行われ、最初に見つかったメソッドが適用されます。これを「左優先則」といいます。したがって、スーパークラスの順番を逆にすると、次のように bar method-a と表示されます。
gosh> (define-class <baz1> (<bar> <foo>) ()) <baz1> gosh> (define b (make <baz1>)) b gosh> (method-a b) bar method-a #<undef>
では、<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」となるのです。上図を経路と考えれば、まさに深さ優先探索そのものですね。これを「深さ優先則」といいます。
それでは実際に試してみましょう。
gosh> (define-class <foo1> (<foo>) ()) <foo1> gosh> (define-class <bar1> (<bar>) ()) <bar1> gosh> (define-class <baz2> (<foo1> <bar1>) ()) <baz2> gosh> (define c (make <baz2>)) c gosh> c #<<baz2> 0pbbbe50> gosh> (method-foo c) foo! #<undef> gosh> (method-bar c) bar! #<undef> gosh> (method-a c) foo method-a #<undef>
クラス <foo1> と <bar1> は <foo> と <bar> を単一継承し、クラス <baz2> は <foo1> と <bar1> を多重継承しています。次に <baz2> のインスタンスを生成し、変数 c にセットします。そして、(method-foo c) を呼び出すと、<foo1> -> <foo> と探索して <foo> の method-foo が見つかります。これを評価して foo! と表示されます。
(method-bar c) を呼び出すと、<foo1> -> <foo> -> <bar1> -> <bar> と探索して <bar> の method-bar が見つかります。これを評価して bar! と表示されます。(method-a c) を呼び出すと、<foo1> -> <foo> を探索したところで method-a が見つかるので、このメソッドを評価して foo method-a と表示されます。
では、次の場合はどうなるのでしょうか。
Ａ
／ ＼
／ ＼
Ｂ Ｃ Ｄ→Ｂ→Ｃ→Ａ
＼ ／
＼ ／
Ｄ
図 3 : 多重継承のメソッドの探索 (2)
あるクラスからスーパークラスをたどり、複数の経路で到達できるクラスを「合流点」といいます。上図の場合、クラス A は D - B - A と D - C - A という 2 つの経路があるので合流点になります。メソッドの探索で合流点にぶつかると、そこで探索を中断して次の経路を探索します。そして、最後の経路で合流点に到達したら、それ以降のスーパークラスを探索します。したがって、上図の探索順序は「D → B → C → A」となります。これを「合流則」といいます。
それでは実際に試してみましょう。
gosh> (define-class <foo-a> () ()) <foo-a> gosh> (define-class <foo-b> (<foo-a>) ()) <foo-b> gosh> (define-class <foo-c> (<foo-a>) ()) <foo-c> gosh> (define-class <foo-d> (<foo-b> <foo-c>) ()) <foo-d> gosh> (define-method method-b ((x <foo-a>)) (print "foo-a method-b")) #<generic method-b (1)> gosh> (define-method method-b ((x <foo-c>)) (print "foo-c method-b")) #<generic method-b (2)> gosh> (define x (make <foo-d>)) x gosh> (method-b x) foo-c method-b #<undef>
4 つのクラス <foo-a>, <foo-b>, <foo-c>, <foo-d> とメソッド method-b を定義します。method-b は <foo-a> と <foo-c> に定義します。<foo-a> が合流点であることに注意してください。<foo-d> のインスタンスを生成して method-b を呼び出すと、foo-c method-b と表示されますね。<foo-a> のメソッドではなく、<foo-c> のメソッドが適用されたことがわかります。
このように Gauche は「適用可能なメソッド」を探索するのですが、実際にはもっと複雑な処理を行っています。Gauche や CLOS の場合、適用可能なメソッドとは「クラス優先順位リスト」と呼ばれるものの中で、一番最初にその引数特定子があらわれるものになります。
Gauche の場合、クラスの優先順位リストは関数 class-precedence-list で求めることができます。
gosh> (class-precedence-list <foo-d>) (#<class <foo-d>> #<class <foo-b>> #<:class <foo-c>> #<class <foo-a>> #<class <object>> #<class <top>>)
クラス <top> は Gauche のオブジェクト指向システムの中で最上位のスーパークラスです。クラス <object> はユーザーが定義したクラスが暗黙のうちに継承するスーパークラスです。私たちが define-class で定義したクラスは、スーパークラスを指定しなくても <object> を継承しているわけです。
このように、優先順位はリストの先頭の <foo-d> がいちばん高く、<foo-a> がいちばん低くなります。ここで、method-b の引数特定子は <foo-c> と <foo-a> がありますが、<foo-c> の優先順位が高いので <foo-c> のメソッドが適用されます。
Gauche や CLOS の場合、このクラス優先順位を決めるアルゴリズムがとても複雑なのですが、たいていの場合は今まで説明した次の 3 つの規則を適用した結果と同じになります。
複雑な継承関係でなければ、これらの規則で十分理解できると思います。CLOS のクラス優先順位リストを決定するアルゴリズムは参考文献『LISP 原書第 3 版 (1) (2)』の付録で詳しく説明されています。興味のある方はお読みくださいませ。
「継承」で説明しましたが、Gauche は define-class でスロットを定義するときに、スーパークラスと同じスロット名があってもかまいません。ただし、インスタンス内では、同じスロット名でアクセスできるスロットはひとつしか存在しません。これは多重継承でも同じです。次の例を見てください。
gosh> (define-class <foo> () ((a :accessor foo-a :init-value 1 :init-keyword :a))) <foo> gosh> (define-class <bar> () ((a :accessor bar-a :init-value 2 :init-keyword :b))) <bar> gosh> (define-class <baz> (<foo> <bar>) ()) <baz> gosh> (define x (make <baz>)) x gosh> (foo-a x) 1 gosh> (bar-a x) 1 gosh> (define y (make <baz> :a 10)) y gosh> (foo-a y) 10 gosh> (bar-a y) 10 gosh> (define z (make <baz> :b 100)) z gosh> (foo-a z) 1
クラス <foo> はスロット a を定義しています。クラス <bar> にも同じ名前のスロット a があります。そして、クラス <baz> は <foo> と <bar> を継承しています。この場合、<baz> のインスタンスを生成すると、a に対応するスロットはひとつしかありません。このとき、スロットオプションの優先順位はメソッドの選択と同じ方法で決定されます。
:accessor で指定されたメソッド foo-a, bar-a はどちらも利用することができます。この場合、同じスロット a をアクセスすることになります。:init-value は「クラス優先順位リスト」と同じ規則で決定されます。この場合、左優先則でクラス <foo> の値が優先されます。したがって、(make <baz>) でインスタンスを生成すると、スロット a の初期値は 1 になります。実際に、メソッド foo-a, bar-a で値を求めると、1 に初期化されていることがわかります。:init-keyword は <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 や Gauche における多重継承の問題点です。
このように、多重継承はどんなクラスでもできるというわけではありません。同名のスロットを持つクラスは多重継承できないと考えた方がよいでしょう。それから、多重継承にはもうひとつ問題点があります。それはクラスの階層構造が複雑になることです。
単一継承の場合、クラスの階層は木構造になりますが、多重継承ではグラフになります。木構造の場合、クラスの優先順位は簡単にわかりますが、グラフになると優先順位を理解するのは難しくなります。多重継承は強力な機能ですが、使うときには十分な注意が必要なのです。
これらの問題を回避するため、スロット (属性) を継承するスーパークラスはひとつだけに限定して、あとのスーパークラスはメソッド (実装) だけを継承するという方法があります。この方法を Mix-in といいます。
具体的には、スロットを定義せずにメソッドだけを記述したクラスを用意します。属性の継承は単一継承になりますが、実装のみを記述したクラスはいくつ継承してかまいません。ひとつのクラスに複数の実装を混ぜることから Mix-in と呼ばれています。
なお、Mix-in は特別な機能ではなく、多重継承を使いこなすための方法論にすぎません。多重継承を扱うことができるプログラミング言語であれば Mix-in を行うことが可能です。なお、もともと Mix-in は Flavors という Lisp にあるオブジェクト指向機能です。CLOS は Flavors の影響を強く受けています。この Mix-in を言語仕様に取り込んだのが Ruby です。
Gauche は多重継承をサポートしているので、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>
; クラス定義
(define-class <enumerable> () ())
; fold の定義
(define-method enum-fold ((d <dlist>) func init . opts)
(apply dlist-fold d func init opts))
; func が真となる要素を返す
(define-method enum-find ((d <enumerable>) func)
(call/cc
(lambda (exit)
(enum-fold d (lambda (a x) (if (func x) (exit x) #f)) #f))))
; func が真となる要素の位置を返す
(define-method enum-position ((d <enumerable>) func)
(call/cc
(lambda (exit)
(enum-fold d (lambda (n x) (if (func x) (exit n) (+ n 1))) 0)
#f)))
; func が真となる要素の個数を返す
(define-method enum-count ((d <enumerable>) func)
(enum-fold d (lambda (n x) (if (func x) (+ n 1) n)) 0))
; マッピング
(define-method enum-map ((d <enumerable>) func)
(enum-fold d (lambda (x a) (cons (func x) a)) '() :from-end #t))
; フィルター
(define-method enum-filter((d <enumerable>) func)
(enum-fold d (lambda (x a) (if (func x) (cons x a) a)) '() :from-end #t))
クラス <enumerable> は Mix-in を前提としているので、スロットの定義は不要でメソッドだけを定義します。要素のアクセスは enum-fold で行います。enum-fold は Mix-in するクラスで定義されているものとします。つまり、enum-fold を定義さえすれば、どんなクラスでも <enumberable> を Mix-in することができるわけです。<dlist> の enum-fold は dlist-fold を呼び出すだけです。
それでは、<dlist> と <enumerable> を継承したクラス <enum-dlist> を作って、実際に試してみましょう。
gosh> (define-class <enum-dlist> (<dlist> <enumerable>) ()) <enum-dlist> gosh> (define a (make <enum-dlist>)) a gosh> a #<<enum-dlist> 0pbea6d8> gosh> (dotimes (x 5) (dlist-insert! a -1 x)) #t gosh> (dlist->list a) (0 1 2 3 4) gosh> (enum-find a even?) 0 gosh> (enum-find a odd?) 1 gosh> (enum-position a (lambda (x) (< 5 x))) #f gosh> (enum-position a (lambda (x) (< 2 x))) 3 gosh> (enum-count a even?) 3 gosh> (enum-map a (lambda (x) (* x x))) (0 1 4 9 16) gosh> (enum-filter a even?) (0 2 4)
正常に動作していますね。複数のクラスで共通の操作 (メソッド) を定義したい場合、Mix-in はとても役に立ちます。
ところで、<dlist> が <enumerable> を継承すれば、<dlist> のインスタンスに <enumerable> のメソッドを適用することができます。この場合、<dlist> を継承するクラス、たとえば <fixed-dlist> は <enumerable> を Mix-in しなくても <enumerable> のメソッドを利用することができます。また、<dlist> が <enumerable> を継承しない場合でも、<fixed-dlist> で <enumerable> を Mix-in すれば、<fixed-dlist> で <enumerable> のメソッドを利用することができます。
<enumerable> はメソッド enum-fold を呼び出すことで動作しますが、畳み込みのかわりにイテレータを使う方法もあります。Gauche のコレクションクラス <collection> を参考にプログラムを作ってみましょう。
Gauche のコレクションクラスはハッシュ表 <hash-table>、リスト <list>、文字列 <string>、ベクタ <vector> などのスーパークラスで、複数のデータを格納するデータ構造 (コレクション) を表す抽象クラスです。<collection> を継承 (Mix-in) することで、<collection> のメソッドを利用できるようになります。このとき、基本となるメソッドが call-with-iterator です。
call-with-iterator collection proc [opts]
call-with-iterator は高段関数 (メソッド) で、関数 proc には 2 つの関数が渡されて呼び出されます。第 1 引数はコレクションの終了判定を行う関数、第 2 引数はコレクションの要素を順番に取り出す関数 (イテレータ) です。どちらの関数も引数はありません。proc はこれらの関数を使ってコレクションの要素を取り出して、適切な処理を行います。
双方向リスト用の call-with-iterator は次のようになります。
リスト : 双方向リスト用のイテレータ
(define-method call-with-iterator ((d <dlist>) proc . opts)
(let* ((next (if (get-keyword :from-end opts #f) cell-prev cell-next))
(cp (next (dlist-top d))))
(proc
(lambda () (eq? cp (dlist-top d)))
(lambda ()
(if (eq? cp (dlist-top d))
#f
(begin0 (cell-item cp)
(set! cp (next cp))))))))
どちらの関数もクロージャを使って実装します。第 1 引数に渡す終了判定用の関数は簡単ですね。第 2 引数に渡すイテレータは、変数 cp の要素を cell-item で取り出して、その後 cp の値を次のセルに更新します。これで、イテレータを呼び出すたびに、双方向リストの要素を順番に取り出していくことができます。
call-with-iterator を使って <enumerable> を書き直すと、次のようになります。
リスト : Mix-in 用クラス (イテレータバージョン)
; Mix-in 用クラスの定義
(define-class <enumerable1> () ())
; func が真となる要素を返す
(define-method enum-find ((d <enumerable1>) func)
(call-with-iterator d
(lambda (end? next)
(let loop ()
(if (end?)
#f
(let ((x (next)))
(if (func x) x (loop))))))))
; func が真となる要素の位置を返す
(define-method enum-position ((d <enumerable1>) func)
(call-with-iterator d
(lambda (end? next)
(let loop ((n 0))
(if (end?)
#f
(let ((x (next)))
(if (func x) n (loop (+ n 1)))))))))
; func が真となる要素の個数を返す
(define-method enum-count ((d <enumerable1>) func)
(call-with-iterator d
(lambda (end? next)
(let loop ((c 0))
(cond ((end?) c)
((func (next)) (loop (+ c 1)))
(else (loop c)))))))
; マッピング
(define-method enum-map ((d <enumerable1>) func)
(call-with-iterator d
(lambda (end? next)
(let loop ((a '()))
(if (end?)
a
(loop (cons (func (next)) a)))))
:from-end #t))
; フィルター
(define-method enum-filter ((d <enumerable1>) func)
(call-with-iterator d
(lambda (end? next)
(let loop ((a '()))
(if (end?)
a
(let ((x (next)))
(if (func x) (loop (cons x a)) (loop a))))))
:from-end #t))
; 畳み込み
(define-method enum-fold-left ((d <enumerable1>) func init)
(call-with-iterator d
(lambda (end? next)
(let loop ((a init))
(if (end?)
a
(loop (func a (next))))))))
; 畳み込み
(define-method enum-fold-right ((d <enumerable1>) func init)
(call-with-iterator d
(lambda (end? next)
(let loop ((a init))
(if (end?)
a
(loop (func (next) a)))))
:from-end #t))
end? で <enumberable1> を継承したコレクションの終端をチェックし、next でその要素を取り出していくだけのなで、とくに難しいところはないと思います。簡単な実行例を示します。
gosh> (define-class <enum-dlist1> (<dlist> <enumerable1>) ()) <enum-dlist1> gosh> (define a (make <enum-dlist1>)) a gosh> (dotimes (x 8) (dlist-insert! a -1 (+ x 1))) #t gosh> (dlist->list a) (1 2 3 4 5 6 7 8) gosh> (enum-find a even?) 2 gosh> (enum-position a even?) 1 gosh> (enum-count a even?) 4 gosh> (enum-map a (lambda (x) (* x x))) (1 4 9 16 25 36 49 64) gosh> (enum-filter a even?) (2 4 6 8) gosh> (enum-fold-left a (lambda (a x) (cons x a)) '()) (8 7 6 5 4 3 2 1) gosh> (enum-fold-right a (lambda (x a) (cons x a)) '()) (1 2 3 4 5 6 7 8)
正常に動作していますね。双方向リストの場合、畳み込みとイテレータどちらの方法でも Mix-in を簡単に実現することができます。このほかにも、いくつかの方法が考えられますが、本ページの範囲を超えるので割愛いたします。Gauche のユーザリファレンス「9.3 gauche.collection - コレクションフレームワーク」にわかりやすい説明があるので、興味のある方はお読みください。
ところで、実際に双方向リストを Gauche で使用するのであれば、<enumerable> のような独自のクラスを作成するよりも、<collection> または列 (シーケンス) を表すクラス <sequence> を継承したほうが便利です。そこで、次回は <collection> と <sequence> について詳しく説明します。
;
; dlist1.scm : 双方向リスト (Mix-in のテスト)
;
; Copyright (C) 2010 Makoto Hiroi
;
; セルの定義
(define-class <cell> ()
((item :accessor cell-item :init-value #f :init-keyword :item)
(prev :accessor cell-prev :init-value #f :init-keyword :prev)
(next :accessor cell-next :init-value #f :init-keyword :next)))
; 空リストを作る
(define (make-empty)
(let ((cp (make <cell>)))
(set! (cell-prev cp) cp)
(set! (cell-next cp) cp)
cp))
; 双方向リストの定義
(define-class <dlist> ()
((top :accessor dlist-top :init-form (make-empty))))
; n 番目のセルを返す (作業用関数)
(define (cell-nth d n next)
(let loop ((i -1) (cp (dlist-top d)))
(cond ((and (<= 0 i) (eq? (dlist-top d) cp))
(error "cell-nth --- oops!"))
((= n i) cp)
(else
(loop (+ i 1) (next cp))))))
; 参照
(define-method dlist-ref ((d <dlist>) (n <integer>))
(cell-item
(if (negative? n)
(cell-nth d (abs (+ n 1)) cell-prev)
(cell-nth d n cell-next))))
; 書き換え
(define-method dlist-set! ((d <dlist>) (n <integer>) value)
(set! (cell-item (if (negative? n)
(cell-nth d (abs (+ n 1)) cell-prev)
(cell-nth d n cell-next)))
value))
; 挿入
(define-method dlist-insert! ((d <dlist>) (n <integer>) value)
(define (cell-insert! n next prev)
(let* ((p (cell-nth d (- n 1) next))
(q (next p))
(cp (make <cell> :item value)))
(set! (next cp) q)
(set! (prev cp) p)
(set! (prev q) cp)
(set! (next p) cp)))
;
(if (negative? n)
(cell-insert! (abs (+ n 1)) cell-prev cell-next)
(cell-insert! n cell-next cell-prev)))
; 削除
(define-method dlist-delete! ((d <dlist>) (n <integer>))
(define (cell-delete! n next prev)
(let* ((cp (cell-nth d n next))
(p (prev cp))
(q (next cp)))
(set! (next p) q)
(set! (prev q) p)
(cell-item cp)))
;
(if (negative? n)
(cell-delete! (abs (+ n 1)) cell-prev cell-next)
(cell-delete! n cell-next cell-prev)))
; 畳み込み
(define-method dlist-fold ((d <dlist>) func init . args)
(let ((next (if (get-keyword :from-end args #f) cell-prev cell-next)))
(let loop ((cp (next (dlist-top d))) (a init))
(if (eq? cp (dlist-top d))
a
(loop (next cp)
(if (eq? next cell-prev)
(func (cell-item cp) a)
(func a (cell-item cp))))))))
; サイズ
(define-method dlist-length ((d <dlist>))
(dlist-fold d (lambda (x y) (+ x 1)) 0))
; クリア
(define-method dlist-clear ((d <dlist>))
(let ((cp (dlist-top d)))
(set! (cell-next cp) cp)
(set! (cell-prev cp) cp)))
; 空リストか？
(define-method dlist-empty? ((d <dlist>))
(let ((cp (dlist-top d)))
(eq? cp (cell-next cp))))
; 変換
(define-method list->dlist ((xs <list>))
(let ((d (make <dlist>)))
(for-each
(lambda (x) (dlist-insert! d -1 x))
xs)
d))
;
(define-method dlist->list ((d <dlist>))
(dlist-fold d
(lambda (x y) (cons x y))
'()
:from-end #t))
; 巡回
(define-method dlist-for-each ((d <dlist>) func . args)
(if (get-keyword :from-end args #f)
(dlist-fold d (lambda (x y) (func x)) #f :from-end #t)
(dlist-fold d (lambda (x y) (func y)) #f)))
;;; Mix-in 畳み込みバージョン
; enum-fold の定義
(define-method enum-fold ((d <dlist>) func init . opts)
(apply dlist-fold d func init opts))
; Mix-in 用クラスの定義
(define-class <enumerable> () ())
; func が真となる要素を返す
(define-method enum-find ((d <enumerable>) func)
(call/cc
(lambda (exit)
(enum-fold d (lambda (a x) (if (func x) (exit x) #f)) #f))))
; func が真となる要素の位置を返す
(define-method enum-position ((d <enumerable>) func)
(call/cc
(lambda (exit)
(enum-fold d (lambda (n x) (if (func x) (exit n) (+ n 1))) 0)
#f)))
; func が真となる要素の個数を返す
(define-method enum-count ((d <enumerable>) func)
(enum-fold d (lambda (n x) (if (func x) (+ n 1) n)) 0))
; マッピング
(define-method enum-map ((d <enumerable>) func)
(enum-fold d (lambda (x a) (cons (func x) a)) '() :from-end #t))
; フィルター
(define-method enum-filter((d <enumerable>) func)
(enum-fold d (lambda (x a) (if (func x) (cons x a) a)) '() :from-end #t))
;;; Mix-in イテレータバージョン
; イテレータを渡して proc を実行する
(define-method call-with-iterator ((d <dlist>) proc . opts)
(let* ((next (if (get-keyword :from-end opts #f) cell-prev cell-next))
(cp (next (dlist-top d))))
(proc
(lambda () (eq? cp (dlist-top d)))
(lambda ()
(if (eq? cp (dlist-top d))
#f
(begin0 (cell-item cp)
(set! cp (next cp))))))))
; Mix-in 用クラスの定義
(define-class <enumerable1> () ())
; func が真となる要素を返す
(define-method enum-find ((d <enumerable1>) func)
(call-with-iterator d
(lambda (end? next)
(let loop ()
(if (end?)
#f
(let ((x (next)))
(if (func x) x (loop))))))))
; func が真となる要素の位置を返す
(define-method enum-position ((d <enumerable1>) func)
(call-with-iterator d
(lambda (end? next)
(let loop ((n 0))
(if (end?)
#f
(let ((x (next)))
(if (func x) n (loop (+ n 1)))))))))
; func が真となる要素の個数を返す
(define-method enum-count ((d <enumerable1>) func)
(call-with-iterator d
(lambda (end? next)
(let loop ((c 0))
(cond ((end?) c)
((func (next)) (loop (+ c 1)))
(else (loop c)))))))
; マッピング
(define-method enum-map ((d <enumerable1>) func)
(call-with-iterator d
(lambda (end? next)
(let loop ((a '()))
(if (end?)
a
(loop (cons (func (next)) a)))))
:from-end #t))
; フィルター
(define-method enum-filter ((d <enumerable1>) func)
(call-with-iterator d
(lambda (end? next)
(let loop ((a '()))
(if (end?)
a
(let ((x (next)))
(if (func x) (loop (cons x a)) (loop a))))))
:from-end #t))
; 畳み込み
(define-method enum-fold-left ((d <enumerable1>) func init)
(call-with-iterator d
(lambda (end? next)
(let loop ((a init))
(if (end?)
a
(loop (func a (next))))))))
; 畳み込み
(define-method enum-fold-right ((d <enumerable1>) func init)
(call-with-iterator d
(lambda (end? next)
(let loop ((a init))
(if (end?)
a
(loop (func (next) a)))))
:from-end #t))