M.Hiroi's Home Page

Functional Programming

お気楽 Scheme プログラミング入門

オブジェクト指向編

[ PrevPage | Scheme | NextPage ]

コレクションとシーケンス

今回はコレクション <collection> とシーケンス <sequence> について説明します。Gauche のオブジェクト指向システムは、ハッシュテーブル <hash-table>、リスト <list>、文字列 <string>、ベクタ <vector> などをコレクションとして統一的に扱うことができます。また、コレクションのサブクラスであるシーケンスを使うと、リスト、文字列、ベクタを同じメソッドで操作することもできます。まず最初に、既存のデータ型とクラスの関係を簡単に説明します。

●既存のデータ型とクラスの関係

Gauche の場合、Gauche (Scheme) で定義されているおもなデータ型をクラスとして利用することができます。そして、それらのクラスには「クラス優先順位リスト」が設定されています。おもなクラスの優先順位リストを示します。

 データ型を調べる述語        クラス優先順位リスト
------------------------------------------------------------------------------------
 boolean?    (真偽値)        (<boolean> <top>)
 char?       (文字)          (<char> <top>)
 complex?    (複素数)        (<complex> <number> <top>)
 hash-table? (ハッシュ表)    (<hash-table> <dictionary> <collection> <top>)
 integer?    (整数値)        (<integer> <rational> <real> <complex> <number> <top>)
 list?       (リスト)        (<list> <sequence> <collection> <top>)
 null?       (空リスト)      (<null> <list> <sequence> <collection> <top>)
 number?     (数)            (<number> <top>)
 pair?       (コンスセル)    (<pair> <list> <sequence> <collection> <top>)
 procedure?  (関数)          (<procedure> <top>)
 port?       (入出力)        (<port> <top>)
 rational?   (有理数)        (<rational> <real> <complex> <number> <top>)
 real?       (浮動小数点数)  (<real> <complex> <number> <top>)
 string?     (文字列)        (<string> <sequence> <collection> <top>)
 symbol?     (シンボル)      (<symbol> <top>)
 vector?     (配列)          (<vector> <sequence> <collection> <top>)

Gauche の場合、すべてのクラスのスーパークラスとして <top> が設定されています。また、define-class でスーパークラスの指定がない場合、暗黙のうちに <object> がスーパークラスとして設定されますが、<object> のスーパークラスも <top> になります。なお、define-method で引数特定子を省略することができましたが、これは <top> を指定していることと同じになります。

これらのクラスは「組み込みクラス (builtin class) 」と呼ばれます。組み込みクラスは make でインスタンスを生成することはできません。また、define-class で組み込みクラスのサブクラスを定義することもできません。ただし、define-method の引数特定子として指定することができます。

なお、<collection> や <sequence> は「抽象クラス」と呼ばれていて、make でインスタンスを生成することはできませんが、それらを継承 (Mix-in) して独自のコレクションクラスやシーケンスクラスを作ることができます。

●コレクションのメソッド

Gauche のクラス <hash-table>, <list>, <string>, <vector> はクラス <collection> を継承しています。gauche.coolection をロードすると、これらのデータをコレクションというデータ型として統一的に操作することができます。

高階関数 fold, map, for-each, filter, remove はコレクションを扱えるように拡張されます。map, filter, remove の返り値はリストになります。

fold func init coll1 coll2 ...
map func coll1 coll2 ...
for-each func coll1 coll2 ...
filter func coll
remove func coll

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

gosh> (use gauche.collection)
#<undef>
gosh> (fold (lambda (x y) (+ x y)) 0 '(1 2 3 4 5))
15
gosh> (fold (lambda (x y) (+ x y)) 0 #(1 2 3 4 5))
15
gosh> (map (lambda (x) (* x x)) '(1 2 3 4 5))
(1 4 9 16 25)
gosh> (map (lambda (x) (* x x)) #(1 2 3 4 5))
(1 4 9 16 25)
gosh> (for-each (lambda (x) (print x)) '(a b c d e))
a
b
c
d
e
#<undef>
gosh> (for-each (lambda (x) (print x)) "abcde")
a
b
c
d
e
#t
gosh> (filter even? '(1 2 3 4 5))
(2 4)
gosh> (filter even? #(1 2 3 4 5))
(2 4)
gosh> (remove even? '(1 2 3 4 5))
(1 3 5)
gosh> (remove even? #(1 2 3 4 5))
(1 3 5)

fold, map, for-each に複数のコレクションを渡す場合、データ型が異なっていてもかまいません。

gosh> (map (lambda (x y) (+ x y)) '(1 2 3 4 5) #(10 20 30 40 50))
(11 22 33 44 55)
gosh> (fold (lambda (x y a) (cons (list x y) a)) '() '(1 2 3) #(4 5 6))
((3 6) (2 5) (1 4))
gosh> (for-each (lambda (x y) (format #t "~S ~S~%" x y)) '(1 2 3) #(4 5 6))
1 4
2 5
3 6
#t

返り値のデータ型を指定したい場合は、map-to, filter-to, remove-to を使います。

map-to class func coll1 coll2 ...
filter-to class func coll
remove-to class func coll
gosh> (map-to <vector> (lambda (x) (* x x)) '(1 2 3 4 5))
#(1 4 9 16 25)
gosh> (map-to <list> (lambda (x) (* x x)) #(1 2 3 4 5))
(1 4 9 16 25)
gosh> (filter-to <list> even? #(1 2 3 4 5))
(2 4)
gosh> (remove-to <vector> even? '(1 2 3 4 5))
#(1 3 5)

メソッド find は述語 pred が真となる collection の要素を返します。

find pred collection

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

gosh> (find even? '(1 3 5 8 9))
8
gosh> (find even? #(1 3 5 8 9))
8

このほかにも便利なメソッドが用意されています。詳細は Gauche のユーザリファレンス gauche.collection - コレクションフレームワーク をお読みください。

●シーケンスのメソッド

Gauche のクラス <list>, <string>, <vector> はクラス <sequence> も継承しています。gauche.sequence をロードすると、これらのデータをシーケンスというデータ型として統一的に操作することができます。

シーケンスの要素はメソッド ref でアクセスすることができます。

ref sequence index

添字 index は 0 から数えます。ref は汎変数として使うことができます。簡単な例を示しましょう。

gosh> (use gauche.sequence)
#<undef>
gosh> (define a '(1 2 3 4 5))
a
gosh> (define b #(1 2 3 4 5))
b
gosh> (ref a 2)
3
gosh> (ref b 3)
4
gosh> (set! (ref a 1) 20)
#<undef>
gosh> a
(1 20 3 4 5)
gosh> (set! (ref b 0) 10)
#<undef>
gosh> b
#(10 2 3 4 5)

クラス <sequence> には添字を引数に渡す高階関数 (メソッド) が用意されています。

fold-with-index func init seq1 seq2 ...
map-with-index func seq1 seq2 ...
map-to-with-index class func seq1 seq2 ...
for-each-with-index func seq1 seq2 ...

関数 func の第 1 引数に添字が渡されます。簡単な例を示しましょう。

gosh> (fold-with-index (lambda (n x a) (cons (cons n x) a)) '() '(a b c d e))
((4 . e) (3 . d) (2 . c) (1 . b) (0 . a))
gosh> (map-with-index (lambda (n x) (cons n x)) '(a b c d e))
((0 . a) (1 . b) (2 . c) (3 . d) (4 . e))
gosh> (map-to-with-index <vector> (lambda (n x) (cons n x)) '(a b c d e))
#((0 . a) (1 . b) (2 . c) (3 . d) (4 . e))
gosh> (for-each-with-index (lambda (n x) (format #t "~D:~S~%" n x)) '(a b c d e))
0:a
1:b
2:c
3:d
4:e
#t

シーケンスの末尾から畳み込みを行う fold-right もあります。

fold-right func init seq1 seq2 ...

func の第 1 引数にシーケンスの要素、第 2 引数に累積変数が渡されます。簡単な例を示しましょう。

gosh> (fold-right list '() '(a b c d e))
(a (b (c (d (e ())))))
gosh> (fold-right list '() #(a b c d e))
(a (b (c (d (e ())))))

述語 pred が真となる要素の位置が知りたい場合は find-with-index を使うと便利です。

find-with-index pred seq1 seq2 ...

find-with-index は見つけた要素の位置とその値の 2 つを返します。見つからない場合は #f を 2 つ返します。簡単な例を示します。

gosh> (find-with-index even? '(1 3 5 7 8 9))
4
8
gosh> (find-with-index odd? '(1 3 5 7 8 9))
0
1
gosh> (find-with-index even? '(1 3 5 7 9))
#f
#f

Gauche はメソッド subseq でシーケンスのスライス操作を行うことができます。

subseq seq [start [end]]

subseq はシーケンス seq の部分列を取り出します。subseq の start と end はコピーする範囲を指定します。end を省略すると列の最後尾が範囲となります。start 位置の要素はコピー範囲に含まれますが、end 位置の要素は範囲外になることに注意してください。次の図を見てください。

1 番目の要素 b は範囲内ですが 5 番目の要素 f は範囲外なので、コピーされたリストに f は含まれません。

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

gosh> (subseq '(a b c d e) 1 4)
(b c d)
gosh> (subseq '(a b c d e) 1)
(b c d e)
gosh> (subseq '(a b c d e))
(a b c d e)
gosh> (subseq #(a b c d e) 1 3)
#(b c)
gosh> (subseq #(a b c d e) 1 1)
#()
gosh> (subseq "abcde" 1 4)
"bcd"

set! と subseq を組み合わせて、シーケンスを破壊的に修正することができます。

(set! (subseq seq start end) value-seq)
(set! (subseq seq start) value-seq)

value-seq はシーケンスの型であれば何でもかまいません。seq の start 番目から end - 1 番目の値を value-seq の値で書き換えます。value-seq の要素数が end - start よりも少ない場合はエラーになります。end が省略された場合は、start 番目から value-seq の要素数だけ書き換えられます。

簡単な例を示します。

gosh> (define a '(1 2 3 4 5))
a
gosh> (set! (subseq a 1 4) '(a b c))
#t
gosh> a
(1 a b c 5)
gosh> (set! (subseq a 0) '(A B))
#t
gosh> a
(A B b c 5)

このほかにも便利なメソッドが用意されています。詳細は Gauche のユーザリファレンス gauche.sequence - シーケンスフレームワーク をお読みください。

●コレクションクラスの実装

次は、コレクションクラスを作成する方法を説明します。基本的にはユーザが定義したクラスに <collection> を Mix-in するだけなので簡単です。このとき、基本となるメソッドを 2 つ実装します。ひとつが前回説明した call-with-iterator です。これで filter, find, fold, map, remove などの基本的なメソッドが動作します。もうひとつが call-with-builder です。このメソッドは map-to, remove-to, filter-to などでコレクションを <dlist> に変換するときに呼び出されます。

call-with-builder を実装するとき、<dlist> のメタクラスが必要になります。ここで、メタクラスについて簡単に説明します。

●メタクラスとは?

今までクラスはオブジェクトの「雛形」で、それをもとにして生成される実体がインスタンスと説明しました。この関係を拡張して、「クラスを生み出すためのクラス」というものを考えることができます。これを「メタクラス (meta class) 」といいます。この場合、クラスはメタクラスのインスタンス (オブジェクト) になります。これを「クラスオブジェクト」といいます。

メタクラスを持つオブジェクト指向言語の場合、クラスオブジェクトの動作は、それが属するメタクラスによって規定されています。つまり、メタクラスで定義されているスロットやメソッドにより、インスタンスを生成するといったオブジェクト指向の標準的な動作が決められているわけです。オブジェクト指向言語によっては、この標準的な動作をカスタマイズできるような機能を持っているものもあります。

この仕組みを「メタオブジェクトプロトコル (Meta Object Protocol : MOP) 」といいます。CLOS の MOP は Common Lisp の規格 (ANSI Common Lisp) に含まれていませんが、多くの処理系でサポートされているようです。もちろん、Gauche も MOP をサポートしています。

コレクションクラスの実装では MOP の複雑な機能を使うことはありません。メタクラスを使う目的は、クラスオブジェクトをメソッドの引数に渡すとき、データ型によってメソッドの選択が行われるようにするためです。簡単な例を示しましょう。次のリストを見てください。

リスト 1 : クラスオブジェクトによる処理の振り分け (1)

(define-class <foo> () ())
(define-class <bar> () ())

(define-method baz ((x <class>))
  (cond ((eq? x <foo>) (print "foo!"))
        ((eq? x <bar>) (print "bar!"))
        (else (print "baz --- oops!"))))

実行結果は次のようになります。

gosh> (class-of <foo>)
#<class <class>>
gosh> (class-of <bar>)
#<class <class>>
gosh> (baz <foo>)
foo!
#<undef>
gosh> (baz <bar>)
bar!
#<undef>
gosh> (define-class <foo1> () ())
<foo1>
gosh> (baz <foo1>)
baz --- oops!
#<undef>

define-class で定義されたクラスのメタクラスは <class> になります。したがって、メソッド baz の引数にクラスオブジェクトを渡す場合、引数特定子は <class> になりますが、クラスオブジェクト <foo> と <bar> を区別することができずに、同じメソッドが選択されることになります。クラスオブジェクトによって処理を振り分けたい場合、baz の中で引数 x の型をチェックすることになります。

この場合、メタクラスを定義すると簡単です。

リスト 2 : クラスオブジェクトによる処理の振り分け (2)

(define-class <foo-meta> (<class>) ())
(define-class <bar-meta> (<class>) ())

(define-class <foo> () () :metaclass <foo-meta>)
(define-class <bar> () () :metaclass <bar-meta>)

(define-method baz ((x <foo-meta>)) (print "foo!"))
(define-method baz ((x <bar-meta>)) (print "bar!"))
(define-method baz ((x <class>)) (print "baz --- oops!"))

メタクラスは <class> のサブクラスとして定義します。そして、define-class でクラスを定義するとき、オプション ;metaclass でメタクラスを指定します。<foo> の :metaclass には <foo-meta> が指定されているので、<foo> のメタクラスは <foo-meta> になります。同様に、<bar> のメタクラスに <bar-meta> を指定します。これでメソッド baz の引数特定子に <foo-meta> と <bar-meta> を指定して、クラスオブジェクトの型によって処理を振り分けることができます。

実行例を示します。

gosh> (class-of <foo>)
#<class <foo-meta>>
gosh> (class-of <bar>)
#<class <bar-meta>>
gosh> (baz <foo>)
foo!
#<undef>
gosh> (baz <bar>)
bar!
#<undef>
gosh> (define-class <foo1> () ())
<foo1>
gosh> (baz <foo1>)
baz --- oops!
#<undef>

class-of で <foo> と <bar> のメタクラスを確かめると、<foo-meta> と <bar-meta> になっています。あとはメソッド baz にクラスオブジェクトを渡すと、その型によって適切なメソッドが実行されます。Gauche の場合、コレクションクラスに属するクラスにはメタクラスが定義されています。

●クラスの定義

それでは双方向リストクラス <dlist> に <collection> を Mix-in してみましょう。最初に必要なクラスを定義します。

リスト 3 : 双方向リストクラスの定義

(use gauche.collection)

; メタクラスの定義
(define-class <dlist-meta> (<class>) ())

; 双方向リストの定義
(define-class <dlist> (<collection>)
  ((top :accessor dlist-top :init-form (make-empty)))
  :metaclass <dlist-meta>)

call-with-builder の動作に必要なメタクラス <dlist-meta> を定義します。そして、define-class で <dlist> を定義するとき、クラス <collection> を継承してオプション :metaclass で <dlist-meta> を指定します。これで <dlist> のメタクラスが <dlist-meta> に設定されます。

●メソッドの定義

次はメソッドを定義します。必要なメソッドは call-with-iterator と call-with-builder の 2 つだけです。次のリストを見てください。

リスト 4 : メソッドの定義

; イテレータ
(define-method call-with-iterator ((coll <dlist>) proc . opts)
  (let ((cp (cell-nth coll (get-keyword :start opts 0) cell-next)))
    (proc
      (lambda () (eq? cp (dlist-top coll)))
      (lambda ()
        (if (eq? cp (dlist-top coll))
            #f
          (begin0 (cell-item cp)
                  (set! cp (cell-next cp))))))))

; ビルダー
(define-method call-with-builder ((class <dlist-meta>) proc . opts)
  (let ((dlist (make <dlist>)))
    (proc (lambda (val) (dlist-insert! dlist -1 val))
          (lambda () dlist))))

call-with-iterator は前回のプログラムとほぼ同じです。キーワード引数 :start は <sequence> を Mix-in するときに必要になります。なお、<collection> と <sequence> はキーワード引数 :from-end に対応していません。もしも、:from-end を使いたいメソッドがある場合は、そのメソッドをオーバーライドしてください。

call-with-builder は関数 proc に 2 つの関数を渡して呼び出します。ひとつはコレクションに要素を追加する関数、もうひとつは生成したコレクションをクロージャから取り出して返す関数です。<dlist> のインスタンスを生成して変数 dlist にセットします。最初の関数は dlist-insert! で最後尾に値 val を追加します。次の関数は変数 dlist を返すだけです。

●コレクションの実行例

それでは、簡単な実行例を示しましょう。

gosh> (use gauche.collection)
#<undef>
gosh> (define a (coerce-to <dlist> '(1 2 3 4 5 6 7 8)))
a
gosh> a
#<<dlist> 0pd6a640>
gosh> (coerce-to <vector> a)
#(1 2 3 4 5 6 7 8)
gosh> (size-of a)
8
gosh> (find even? a)
2
gosh> (filter even? a)
(2 4 6 8)
gosh> (remove even? a)
(1 3 5 7)
gosh> (map (lambda (x) (* x x)) a)
(1 4 9 16 25 36 49 64)
gosh> (map (lambda (x y) (* x y)) a '(10 20 30 40 50 60 70 80))
(10 40 90 160 250 360 490 640)
gosh> (fold (lambda (x y) (+ x y)) 0 a)
36
gosh> (for-each (lambda (x) (format #t "~D " x)) a)
1 2 3 4 5 6 7 8 #t
gosh> (map-to <vector> (lambda (x) (* x x)) a)
#(1 4 9 16 25 36 49 64)
gosh> (define b (map-to <dlist> (lambda (x) (* x x)) a))
b
gosh> (for-each (lambda (x) (format #t "~D " x)) b)
1 4 9 16 25 36 49 64 #t
gosh> (partition even? a)
(2 4 6 8)
(1 3 5 7)
gosh> (partition-to <vector> even? a)
#(2 4 6 8)
#(1 3 5 7)

このほかにもコレクションクラスのメソッドがあるので、興味のある方はいろいろ試してみてください。

●シーケンスクラスの実装

コレクションクラスの実装が完成すれば、シーケンスクラスは簡単に実装することができます。次のリストを見てください。

リスト 5 : シーケンスクラスを Mix-in する場合

; 双方向リストの定義
(define-class <dlist> (<sequence>)
  ((top :accessor dlist-top :init-form (make-empty)))
  :metaclass <dlist-meta>)

;;; <sequence> 用メソッド
(define-method referencer ((dlist <dlist>)) dlist-ref)
(define-method modifier ((dlist <dlist>)) dlist-set!)

<dlist> の定義で <collection> ではなく <sequence> を継承するように変更します。<sequence> は <collection> のサブクラスなので、<sequence> を継承すればスーパークラス <collection> のメソッドも利用することができます。あとは、メソッド referencer と modifier を定義します。

(referencer) sequence n
(modifier) sequence n val

referencer は sequence の n 番目の要素を参照する関数 (メソッド) を返し、modifier は sequence の n 番目の要素の値を val に書き換える関数 (メソッド) を返します。<dlist> の場合、referencer は dlist-ref を、modifier は dlist-set! を返すように定義するだけです。これで <sequence> のメソッドを利用できるようになります。

●シーケンスの実行例

簡単な実行例を示します。

gosh> (define a (coerce-to <dlist> '(1 2 3 4 5 6 7 8)))
a
gosh> (dotimes (x (size-of a)) (format #t "~D " (ref a x)))
1 2 3 4 5 6 7 8 #t
gosh> (dotimes (x (size-of a)) (set! (ref a x) (+ x 10)))
#t
gosh> (dotimes (x (size-of a)) (format #t "~D " (ref a x)))
10 11 12 13 14 15 16 17 #t
gosh> (fold-with-index (lambda (n x a) (cons (cons n x) a)) '() a)
((7 . 17) (6 . 16) (5 . 15) (4 . 14) (3 . 13) (2 . 12) (1 . 11) (0 . 10))
gosh> (map-with-index (lambda (n x) (cons n x)) a)
((0 . 10) (1 . 11) (2 . 12) (3 . 13) (4 . 14) (5 . 15) (6 . 16) (7 . 17))
gosh> (define b (map-to-with-index <dlist> (lambda (n x) (cons n x)) a))
b
gosh> (for-each-with-index (lambda (n x) (format #t "~D:~S~%" n x)) b)
0:(0 . 10)
1:(1 . 11)
2:(2 . 12)
3:(3 . 13)
4:(4 . 14)
5:(5 . 15)
6:(6 . 16)
7:(7 . 17)
#t
gosh> (fold-right list '() a)
(10 (11 (12 (13 (14 (15 (16 (17 ()))))))))
gosh> (find-with-index even? a)
0
10
gosh> (find-with-index odd? a)
1
11
gosh> (define c (subseq a 1 7))
c
gosh> (coerce-to <list> c)
(11 12 13 14 15 16)
gosh> (set! (subseq c 1 4) '(a b c))
#t
gosh> (coerce-to <list> c)
(11 a b c 15 16)

このほかにもシーケンスクラスのメソッドがあるので、興味のある方はいろいろ試してみてください。


●プログラムリスト

;
; dlist2.scm : 双方向リスト (シーケンスクラスを継承)
;
;              Copyright (C) 2010 Makoto Hiroi
;
(use gauche.sequence)

; メタクラスの定義
(define-class <dlist-meta> (<class>) ())

; セルの定義
(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> (<sequence>)
  ((top :accessor dlist-top :init-form (make-empty)))
  :metaclass <dlist-meta>)

; 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 . opts)
  (if (get-keyword :from-end opts #f)
      (dlist-fold d (lambda (x y) (func x)) #f :from-end #t)
    (dlist-fold d (lambda (x y) (func y)) #f)))


;;; <collection> 用メソッド

; イテレータ
(define-method call-with-iterator ((coll <dlist>) proc . opts)
  (let ((cp (cell-nth coll (get-keyword :start opts 0) cell-next)))
    (proc
      (lambda () (eq? cp (dlist-top coll)))
      (lambda ()
        (if (eq? cp (dlist-top coll))
            #f
          (begin0 (cell-item cp)
                  (set! cp (cell-next cp))))))))

; ビルダー
(define-method call-with-builder ((class <dlist-meta>) proc . opts)
  (let ((dlist (make <dlist>)))
    (proc (lambda (val) (dlist-insert! dlist -1 val))
          (lambda () dlist))))

;;; <sequence> 用メソッド
(define-method referencer ((dlist <dlist>)) dlist-ref)
(define-method modifier ((dlist <dlist>)) dlist-set!)

Copyright (C) 2010 Makoto Hiroi
All rights reserved.

[ PrevPage | Scheme | NextPage ]