M.Hiroi's Home Page

Functional Programming

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

オブジェクト指向編

[ PrevPage | Scheme | NextPage ]

インスタンスの初期化

Gauche は make でクラスのインスタンスを生成します。スロットの初期値は make でセットすることができますが、このほかに総称関数 initialize を使ってインスタンスの初期化をカスタマイズすることができます。

●総称関数 initialize

initialize は make から呼び出される総称関数です。インスタンスを生成するとき、initialize をオーバーライドすることで独自の初期化処理を行うことができます。

initialize instance initargs

initialize はインスタンスが生成されてから呼び出されます。このとき、スロットは未束縛であることに注意してください。スロットの初期値は :init-form や :init-value を使って設定することができますが、この処理は Gauche が提供する initialize の基本メソッドで行われます。したがって、単純に initialize をオーバーライドすると、スロットは未束縛のままになってしまいます。次の例を見てください。

リスト 1 : initialize の例 (1)

; クラス定義
(define-class <foo> ()
  ((a :accessor foo-a :init-value 1 :init-keyword :a)))

(define-method initialize ((x <foo>) initargs)
  (if (slot-bound? x 'a)
      (format #t "slot a is ~S~%" (foo-a x))
    (print "slot a is unbound")))

この例はクラス <foo> の initialize をオーバーライドしています。slot-bound? はスロットが束縛されているかチェックする関数です。

slot-bound? instance slot-name

slot-name はスロット名を表すシンボルです。instance のスロット slot-name が束縛されていれば #t を、未束縛であれば #f を返します。

それから、任意のオブジェクトにスロットがあるかチェックする関数 slot-exists? もあります。

slot-exists? object slot-name

slot-exists? はオブジェクト object にスロット slot-name が存在すれば #t を、なければ #f を返します。

それでは、クラス <foo> のインスタンスを生成してみましょう。

gosh> (define x (make <foo> :a 10))
slot a is unbound
x
gosh> (slot-bound? x 'a)
#f

make からオーバライドした initialize が呼び出されますが、このときスロット a は未束縛の状態です。このあと、生成されたインスタンスのスロット a を slot-bound? でチェックすると #f が返ってきます。このように、initialize をオーバーライドすると、:init-value や :init-keyword で指定したスロットの初期化処理が行われないのです。

この場合、next-method を呼び出してスーパークラスのメソッド initialize を呼び出すようにします。

リスト 2 : initialize の例 (2)

(define-method initialize ((x <foo>) initargs)
  (next-method)
  (if (slot-bound? x 'a)
      (format #t "slot a is ~S~%" (foo-a x))
    (print "slot a is unbound")))

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

gosh> (define x (make <foo> :a 10))
slot a is 10
x
gosh> (slot-bound? x 'a)
#t

initialize を使ってインスタンスの初期化処理を行う場合は注意してください。

●ベクタによるキューの実装

それでは簡単な例題として、ベクタを使って「キュー (queue) 」を実装してみましょう。ベクタの場合、先頭位置を示す front と末尾を示す rear を用意し、front と rear の間にあるデータをキューに格納されているデータとするのがポイントです。次の図を見てください。


                      図 1 : キューの動作

まずキューは空の状態で、rear, front ともに 0 です。データの追加は、rear が示す位置にデータを書き込み、rear の値をインクリメントします。データ 10, 20, 30 を追加すると、図のようにデータが追加され rear は 3 になります。このとき front は 0 のままなので、先頭のデータは 10 ということになります。

次に、データを取り出す場合、front の示すデータを取り出してから front の値をインクリメントします。この場合、front が 0 なので 10 を取り出して front の値は 1 となり、次のデータ 20 が先頭になります。データを順番に 20, 30 と取り出していくと、3 つしかデータを書き込んでいないので当然キューは空になります。このとき front は 3 になり rear と同じ値になります。

このように、front と rear の値が 0 の場合だけが空の状態ではなく、front と rear の値が等しくなる場合もキューは空になります。実際にプログラムを作る場合は、キューの要素数をカウントする変数を用意しておくと、キューの状態を簡単に判断することができるので便利です。

rear, fornt ともに値は増加していく方向なので、いつかはベクタの範囲をオーバーします。このため、ベクタを先頭と末尾がつがっているリング状と考え、rear, front がベクタの範囲を超えたら 0 に戻すことにします。これを「循環配列」とか「リングバッファ」と呼びます。一般に、ベクタを使ってキューを実装する場合は、リングバッファとするのが普通です。

●プログラムの作成

最初に、キューを操作するためのメソッドを表 1 に示します。

表 1 : キューのメソッド
メソッド機能
enqueue! q xキュー q にデータを追加する
dequeue! q キュー q からデータを取り出す
queue-peek q キュー q の先頭データを参照する
queue-length q キュー q に格納されている要素数を返す
queue-clear! q キュー q を空にする
queue-empty? q キュー q が空ならば #t を返す
queue-full? q キュー q が満杯ならば #t を返す

次に、キューを表すクラスを定義します。

リスト:クラス queue の定義

(define-class <queue> ()
  ((buff  :accessor queue-buff  :init-keyword :buff)
   (size  :accessor queue-size  :init-keyword :size)
   (nums  :accessor queue-nums  :init-keyword :nums  :init-value 0)
   (front :accessor queue-front :init-keyword :front :init-value 0)
   (rear  :accessor queue-rear  :init-keyword :rear  :init-value 0)))

; 初期化
(define-method initialize ((q <queue>) intargs)
  (next-method)
  (if (not (slot-bound? q 'size))
      (error "<queue> : slot size is unbound"))
  (set! (queue-buff q) (make-vector (queue-size q))))

スロット nums はキューに格納されたデータ数をカウントします。この変数を用意することで、キューの状態を簡単にチェックすることができます。スロット size はキューの大きさを表し、スロット buff にはベクタをセットします。ベクタは initialize で生成してスロット buff にセットします。これで大きさ size のベクタを用意することができます。

次はデータを挿入するメソッド enqueue! を作ります。次のリストを見てください。

リスト 3 : データの挿入

(define-method enqueue! ((q <queue>) value)
  (if (queue-full? q)
      (error "queue is full"))
  (vector-set! (queue-buff q) (queue-rear q) value)
  (inc! (queue-nums q))
  (inc! (queue-rear q))
  (if (= (queue-rear q) (queue-size q))
      (set! (queue-rear q) 0)))

まず、メソッド queue-full? を呼び出して、キューが満杯かチェックします。そうであればエラーを送出します。データ value は rear の位置に格納し、nums と rear の値を更新します。そして、rear の値がベクタの範囲を超えたならば 0 に戻します。rear の値を更新する処理は、次のようにプログラムしてもかまいません。

(set! (queue-rear q)
      (modulo (+ (queue-rear q) 1) (queue-size q)))

剰余を求める関数 modulo を使うのがポイントです。

次は、キューの先頭データを参照するメソッド queue-peek と、キューからデータを取り出すメソッド dequeue! を作ります。

リスト 4 : データを取り出す

; 先頭データを参照
(define-method queue-peek ((q <queue>))
  (if (queue-empty? q)
      (error "queue is empty"))
  (vector-ref (queue-buff q) (queue-front q)))

; データの取り出し
(define-method dequeue! ((q <queue>))
  (begin0
    (queue-peek q)
    (dec! (queue-nums q))
    (inc! (queue-front q))
    (if (= (queue-front q) (queue-size q))
        (set! (queue-front q) 0))))

queue-peek はメソッド queue-empty? を呼び出してキューにデータがあるかチェックします。キューが空の場合はエラーを送出します。データがある場合、スロット front の位置にあるデータが先頭なので、vectore-ref で先頭データを取り出して返します。dequeue! は queue-peek で先頭の値を求め、その値を bigin0 で返します。あとはスロット nums を -1 して、front の値を +1 します。front の値がベクタの範囲を超えたら 0 に戻します。

あとのメソッドは簡単なので説明は省略いたします。詳細は プログラムリスト1 をお読みくださいませ。

●実行例

それでは簡単な実行例を示します。

gosh> (define a (make <queue> :size 8))
a
gosh> (dotimes (x 8) (enqueue! a x))
#t
gosh> (enqueue! a 8)
*** ERROR: queue is full

gosh> (queue-length a)
8
gosh> (queue-full? a)
#t
gosh> (queue-empty? a)
#f
gosh> (dotimes (x 8) (format #t "~D " (dequeue! a)))
0 1 2 3 4 5 6 7 #t
gosh> (queue-empty? a)
#t
gosh> (queue-full? a)
#f
gosh> (queue-length a)
0

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


●プログラムリスト1

;
; queue.scm : リングバッファによるキューの実装
;
;             Copyright (C) 2010 Makoto Hiroi
;

;;; キューの定義

(define-class <queue> ()
  ((buff  :accessor queue-buff  :init-keyword :buff)
   (size  :accessor queue-size  :init-keyword :size)
   (nums  :accessor queue-nums  :init-keyword :nums  :init-value 0)
   (front :accessor queue-front :init-keyword :front :init-value 0)
   (rear  :accessor queue-rear  :init-keyword :rear   :init-value 0)))

; 初期化
(define-method initialize ((q <queue>) intargs)
  (next-method)
  (if (not (slot-bound? q 'size))
      (error "<queue> : slot size is unbound"))
  (set! (queue-buff q) (make-vector (queue-size q))))

;;; メソッドの定義

; 空か?
(define-method queue-empty? ((q <queue>))
  (zero? (queue-nums q)))

; 満杯か?
(define-method queue-full? ((q <queue>))
  (= (queue-nums q) (queue-size q)))

; データの挿入
(define-method enqueue! ((q <queue>) value)
  (if (queue-full? q)
      (error "queue is full"))
  (vector-set! (queue-buff q) (queue-rear q) value)
  (inc! (queue-nums q))
  (inc! (queue-rear q))
  (if (= (queue-rear q) (queue-size q))
      (set! (queue-rear q) 0)))

; 先頭データを参照
(define-method queue-peek ((q <queue>))
  (if (queue-empty? q)
      (error "queue is empty"))
  (vector-ref (queue-buff q) (queue-front q)))

; データの取り出し
(define-method dequeue! ((q <queue>))
  (begin0
    (queue-peek q)
    (dec! (queue-nums q))
    (inc! (queue-front q))
    (if (= (queue-front q) (queue-size q))
        (set! (queue-front q) 0))))

; 要素数を求める
(define-method queue-length ((q <queue>))
  (queue-nums q))

; 空にする
(define-method queue-clear! ((q <queue>))
  (set! (queue-nums q) 0)
  (set! (queue-front q) 0)
  (set! (queue-rear q) 0))

可変長ベクタ

今回はオブジェクト指向の簡単な例題として、ベクタを自動的に拡張する「可変長ベクタ (variable length vector) 」を作ってみましょう。Scheme のベクタは生成するときに大きさを指定しますが、その後で大きさを変更することはできません。可変長ベクタはデータを追加するとき、満杯の場合は自動的にベクタを拡張します。可変長ベクタ (配列) は Perl, Python, Ruby などでは標準でサポートされている機能です。

●可変長ベクタの仕様

クラス名は <vlvector> とします。今回は簡単な例題ということで、ベクタの末尾にデータを追加するとき、ベクタが満杯ならば容量を 2 倍に増やすことにしましょう。ただし、ベクタの大きさを自動的に減らすことはしません。そのかわり、ベクタの大きさを変更するメソッドを用意することにします。

可変長ベクタクラス <vlvector> のメソッドを表 1 に示します。

表 1 : 可変長ベクタクラスのメソッド
メソッド機能
vlvector-ref v nn 番目の要素を参照する
vlvector-set! v n x n 番目の要素を x に書き換える
vlvector-push! v xベクタの末尾にデータ x を追加する
vlvector-pop! v ベクタの末尾からデータを取り出す
vlvector-clear! v ベクタを空にする
vlvector-empty? v ベクタが空ならば #t を返す
vlvector-length v ベクタの要素数を返す
vlvector-size v ベクタの大きさ (容量) を返す
vlvector-resize v sizeベクタの大きさを size に変更する
fill-pointer v フィルポインタの値を返す
fill-pointer-set! v nフィルポインタの値を n に書き換える

引数 v はクラス <vlvector> のインスタンスで、引数 n と size は整数値です。プログラムのポイントはフィルポインタ (fill-pointer) の使い方です。ベクタの中で 0 番目から fill-pointer - 1 番目までの要素を有効なデータとして扱います。つまり、fill-pointer でデータの要素数を管理するわけです。

vlvector-push! で末尾にデータを追加する場合、fill-pointer の位置にデータを書き込み、fill-pointer の値を +1 します。vlvector-pop! で末尾からデータを取り出す場合、fill-pointer の値を -1 してから、fill-pointer の位置にある要素を返します。これはスタックの動作と同じになります。

データを追加するとき、fill-pointer の値とベクタの大きさを比較します。同じ値の場合、ベクタは満杯なので容量を 2 倍に増やします。Scheme の場合、ベクタの大きさを変更することはできないので、新しいベクタを生成して元のベクタからデータをコピーします。容量の変更はメソッド vlvector-resize で行います。ベクタを縮小することもできますが、fill-pointer よりも小さくすることはできません。

fill-pointer の値はメソッド fill-pointer-set! で変更することができます。範囲は 0 からベクタの大きさまでです。値が範囲外の場合はエラーを送出します。あとは、クラス <sequence> を Mix-in します。<sequence> のメソッドはベクタの 0 番目から fill-pointer - 1 番目までの要素に対して働きますが、メソッド vlvector-ref と vlvector-set! はベクタ全体にアクセスできるものとします。なお、これらの仕様は Common Lisp の「配列 (array) 」を参考にしました。興味のある方は拙作のページ ベクタとスタック をお読みください。

●クラスの定義とベクタの初期化

それではプログラムを作りましょう。最初にクラスを定義します。

リスト 1 : 可変長ベクタクラスの定義

; メタクラス
(define-class <vlvector-meta> (<class>) ())

; クラス
(define-class <vlvector> (<sequence>)
  ((buff :accessor get-buff :init-keyword :buff)
   (size :accessor get-size :init-value *min-size* :init-keyword :size)
   (nums :accessor get-nums :init-value 0))
  :metaclass <vlvector-meta>)

まず、<sequence> で必要になるメタクラス <vlvector-meta> を定義します。それから、クラス <vlvector> で <sequence> を Mix-in します。スロット buff にベクタを、size にベクタの大きさを、nums に要素数を格納します。この nums が fill-pointer になります。最後に :metaclass に <vlvector-meta> を指定します。

スロット buff の初期化は総称関数 initialize で行います。次のリストを見てください。

リスト 2 : インスタンスの初期化

; 初期化
(define-method initialize ((obj <vlvector>) initargs)
  (next-method)
  (if (< (get-size obj) *min-size*)
      (set! (get-size obj) *min-size*))
  (set! (get-buff obj) (make-vector (get-size obj))))

まず next-method でスーパークラスの initialize を呼び出します。それから、スロット size の値をチェックします。もしも、size がグローバル変数 *min-size* (4) よりも小さい場合は、その値を *min-size* に書き換えます。あとは大きさ size のベクタを make-vector で生成して buff にセットするだけです。

●汎変数の定義

次はフィルポインタを操作するメソッドを作ります。

リスト 3 : フィルポインタの操作

; フィルポインタを求める
(define-method fill-pointer ((v <vlvector>))
  (get-nums v))

; フィルポインタの変更
(define-method fill-pointer-set! ((v <vlvector>) (n <integer>))
  (if (or (negative? n) (< (get-size v) n))
      (error "fill-pointer-set! : out of range"))
  (set! (get-nums v) n))

; 汎変数
(set! (setter fill-pointer) fill-pointer-set!)

メソッド fill-pointer は簡単です。メソッド get-nums でスロット nums の値を求めるだけです。メソッド fill-pointer-set! はスロット num の値を引数 n に書き換えるだけです。このとき、n の値が範囲内 (0 から size まで) であることを確認します。範囲外であればエラーを送出します。

フィルポインタは set! で変更できると便利です。Gauche では汎変数を簡単に定義することができます。これには setter を使います。

setter proc

関数 setter は引数 proc の setter 手続きを返します。Gauche の場合、setter 手続きは値を更新する関数のことです。たとえば、setter 手続きを update とすると、update は (proc args ...) が参照した値を次の形式で更新します。

update args ... value

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

gosh> (setter car)
#<subr set-car!>
gosh> (setter vector-ref)
#<subr vector-set!>
gosh> (setter list-ref)
#f
gosh> (define a '(1 2 3 4 5))
a
gosh> (set! (car a) 10)
#<undef>
gosh> a
(10 2 3 4 5)

car の setter 手続きは set-car! なので、(set! (car a) 10) は (set-car! a 10) に変換されて、リストの先頭要素が 10 に変更されます。また、vector-ref の setter 手続きは vector-set! ですが、list-ref の setter 手続きは定義されていません。

setter 手続きの設定にも汎変数が使えるので簡単です。(set! (setter proc) update) とすれば、proc の setter 手続きを update に設定することができます。fill-pointer の場合も、(set! (setter fill-pointer) fill-pointer-set!) とすれば、fill-pointer の setter 手続きを fill-pointer-set! にすることができます。

●ベクタのリサイズ

次はベクタの大きさを変更するメソッド vlvector-resize を作ります。

リスト 4 : ベクタサイズの変更

(define-method vlvector-resize ((v <vlvector>) (new-size <integer>))
  (if (< new-size (get-nums v))
      (error "vlvector-resize : not enough new-size"))
  (if (< new-size *min-size*)
      (set! new-size *min-size*))
  (let ((new-buff (make-vector new-size)))
    (let loop ((i (- (get-nums v) 1)))
      (cond ((<= 0 i)
             (vector-set! new-buff i (vector-ref (get-buff v) i))
             (loop (- i 1)))))
    (set! (get-buff v) new-buff)
    (set! (get-size v) new-size)))

引数 new-size が新しいベクタの大きさです。new-size が要素数 nums よりも小さい場合はエラーを送出します。new-size が *min-size* よりも小さい場合は、new-size を *min-size* に変更します。あとは、大きさ new-size の新しいベクタを生成して、そこに buff からデータをコピーするだけです。

●データの追加と取り出し

次はメソッド vlvector-push! と vlvector-pop! を作ります。

リスト 5 : データの追加と取り出し

; 追加
(define-method vlvector-push! ((v <vlvector>) value)
  (if (= (get-size v) (get-nums v))
      (vlvector-resize v (* (get-size v) 2)))
  (vector-set! (get-buff v) (get-nums v) value)
  (inc! (get-nums v)))

; 取り出し
(define-method vlvector-pop! ((v <vlvector>))
  (if (vlvector-empty? v)
      (error "vlvector-pop! : <vlvector> is empty"))
  (dec! (get-nums v))
  (vector-ref (get-buff v) (get-nums v)))

vlvector-push! は簡単です。まず、ベクタが満杯かチェックし、そうであれば vlvector-resize を呼び出してベクタの大きさを 2 倍に拡張します。そして、nums の位置にデータ value をセットしてから nums の値を +1 します。

vlvector-pop! は vevector-empty? を呼び出してベクタが空かチェックし、空の場合はエラーを送出します。そして、nums の値を -1 してから、その位置にある要素を取り出して返します。

●イテレータ

次は <sequence> で使うイテレータとビルダーを作ります。

リスト 6 : <sequence> 用メソッド

; イテレータ
(define-method call-with-iterator ((v <vlvector>) proc . opts)
  (let ((n (get-keyword :start opts 0)))
    (proc
      (lambda () (eqv? n (get-nums v)))
      (lambda ()
        (if (eqv? n (get-nums v))
            #f
          (begin0 (vector-ref (get-buff v) n)
                  (inc! n)))))))

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

; 参照
(define-method referencer ((avec <vlvector>)) vlvector-ref)

; 更新
(define-method modifier ((avec <vlvector>)) vlvector-set!)

; オーバーライド
(define-method size-of ((v <vlvector>))
  (vlvector-length v))

(define-method lazy-size-of ((v <vlvector>))
  (vlvector-length v))

ベクタの有効範囲は 0 番目から nums - 1 番目までです。call-with-iterator は変数 n の位置にある要素を取り出して返すだけなので簡単です。call-with-builder も make で <vlvector> のインスタンスを生成して、vlvector-push! で要素を追加していくだけです。

<vlvector> の要素数は簡単に求めることができるので、メソッド size-of と lazy-size-of をオーバーライドして、vlvector-length の値を返すようにします。デフォルトの動作は、call-with-iterator を呼び出してコレクションの大きさを求めています。

後のメソッドは簡単なので説明は割愛いたします。詳細は プログラムリスト2 をお読みください。

●実行例

それでは簡単な実行例を示します。

gosh> (use vlvector)
#<undef>
gosh> (use gauche.sequence)
#<undef>
gosh> (define a (make <vlvector>))
a
gosh> (vlvector-length a)
0
gosh> (vlvector-size a)
4
gosh> (vlvector-empty? a)
#t
gosh> (dotimes (x 10) (vlvector-push! a x))
#t
gosh> (vlvector-length a)
10
gosh> (vlvector-size a)
16
gosh> (vlvector-empty? a)
#f
gosh> (for-each (lambda (x) (format #t "~D " x)) a)
0 1 2 3 4 5 6 7 8 9 #t
gosh> (map (lambda (x) (* x x)) a)
(0 1 4 9 16 25 36 49 64 81)
gosh> (define b (map-to <vlvector> (lambda (x) (* x x)) a))
b
gosh> (for-each (lambda (x) (format #t "~D " x)) b)
0 1 4 9 16 25 36 49 64 81 #t
gosh> (size-of b)
10
gosh> (dotimes (x 10) (format #t "~D " (vlvector-pop! b)))
81 64 49 36 25 16 9 4 1 0 #t
gosh> (size-of b)
0
gosh> (vlvector-empty? b)
#t
gosh> (set! (fill-pointer b) 10)
#<undef>
gosh> (size-of b)
10
gosh> (vlvector-empty? b)
#f
gosh> (dotimes (x 10) (format #t "~D " (vlvector-pop! b)))
81 64 49 36 25 16 9 4 1 0 #t

正常に動作しているようです。興味のある方はいろいろ試してみてください。


●プログラムリスト2

;
; vlvector.scm : 可変長ベクタクラス (variable-length vector)
;
;                Copyright (C) 2010 Makoto Hiroi
;

(define-module vlvector
  (use gauche.sequence)
  (export <vlvector>
          vlvector-ref    vlvector-set!
          vlvector-push!  vlvector-pop!
          vlvector-empty? vlvector-clear!
          vlvector-length vlvector-size
          fill-pointer    fill-pointer-set!
          vlvector-resize
          call-with-iterator
          call-with-builder
          referencer
          modifier))

(select-module vlvector)

;;; 定数
(define *min-size* 4)

;;; クラス定義

; メタクラス
(define-class <vlvector-meta> (<class>) ())

; クラス
(define-class <vlvector> (<sequence>)
  ((buff :accessor get-buff :init-keyword :buff)
   (size :accessor get-size :init-value *min-size* :init-keyword :size)
   (nums :accessor get-nums :init-value 0))
  :metaclass <vlvector-meta>)

; 初期化
(define-method initialize ((obj <vlvector>) initargs)
  (next-method)
  (if (< (get-size obj) *min-size*)
      (set! (get-size obj) *min-size*))
  (set! (get-buff obj) (make-vector (get-size obj))))

;;; メソッドの定義

; 空にする
(define-method vlvector-clear! ((v <vlvector>))
  (set! (get-nums v) 0))

; 空か?
(define-method vlvector-empty? ((v <vlvector>))
  (zero? (get-nums v)))

; フィルポインタを求める
(define-method fill-pointer ((v <vlvector>))
  (get-nums v))

; フィルポインタの変更
(define-method fill-pointer-set! ((v <vlvector>) (n <integer>))
  (if (or (negative? n) (< (get-size v) n))
      (error "fill-pointer-set! : out of range"))
  (set! (get-nums v) n))

; 汎変数
(set! (setter fill-pointer) fill-pointer-set!)

; 要素数を求める
(define-method vlvector-length ((v <vlvector>))
  (get-nums v))

; 大きさを求める
(define-method vlvector-size ((v <vlvector>))
  (get-size v))

; 参照 (ベクタ全体にアクセスできる)
(define-method vlvector-ref ((v <vlvector>) (n <integer>))
  (vector-ref (get-buff v) n))

; 更新 (ベクタ全体にアクセスできる)
(define-method vlvector-set! ((v <vlvector>) (n <integer>) value)
  (vector-set! (get-buff v) n value))

; 大きさの変更
(define-method vlvector-resize ((v <vlvector>) (new-size <integer>))
  (if (< new-size (get-nums v))
      (error "vlvector-resize : not enough new-size"))
  (if (< new-size *min-size*)
      (set! new-size *min-size*))
  (let ((new-buff (make-vector new-size)))
    (let loop ((i (- (get-nums v) 1)))
      (cond ((<= 0 i)
             (vector-set! new-buff i (vector-ref (get-buff v) i))
             (loop (- i 1)))))
    (set! (get-buff v) new-buff)
    (set! (get-size v) new-size)))

; 追加
(define-method vlvector-push! ((v <vlvector>) value)
  (if (= (get-size v) (get-nums v))
      (vlvector-resize v (* (get-size v) 2)))
  (vector-set! (get-buff v) (get-nums v) value)
  (inc! (get-nums v)))

; 取り出し
(define-method vlvector-pop! ((v <vlvector>))
  (if (vlvector-empty? v)
      (error "vlvector-pop! : <vlvector> is empty"))
  (dec! (get-nums v))
  (vector-ref (get-buff v) (get-nums v)))

;;; イテレータ (fill-pointer までが有効)
(define-method call-with-iterator ((v <vlvector>) proc . opts)
  (let ((n (get-keyword :start opts 0)))
    (proc
      (lambda () (eqv? n (get-nums v)))
      (lambda ()
        (if (eqv? n (get-nums v))
            #f
          (begin0 (vector-ref (get-buff v) n)
                  (inc! n)))))))

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

; 参照
(define-method referencer ((avec <vlvector>)) vlvector-ref)

; 更新
(define-method modifier ((avec <vlvector>)) vlvector-set!)

; オーバーライド
(define-method size-of ((v <vlvector>))
  (vlvector-length v))

(define-method lazy-size-of ((v <vlvector>))
  (vlvector-length v))

(provide "vlvector")

Copyright (C) 2010 Makoto Hiroi
All rights reserved.

[ PrevPage | Scheme | NextPage ]