この節では Gauche のオブジェクトシステムの基本的構造について手短かに 説明します。Gauche のオブジェクトシステムは CLOS (Common-Lisp Object System) に強く影響されています。CLOS やそれにかかわりのある TinyCLOS、STklos、 あるいは Guile のオブジェクトシステムの経験がある方は、この節を飛ばして、 次の節にいってもよいでしょう。
CLOS 風のオブジェクトシステムでは 3 つの概念が中心的な役割をはたします。 クラス、ジェネリック関数、それにメソッドです。
クラスはオブジェクトの構造を指定します。また、データ型も定義します (厳密にいうと、データ型とはちがうものですが、難しいところは今は おいておきましょう)。
たとえば、2 次元空間の点は x 座標と y 座標で表現できます。点のクラスは
define-class マクロを使って定義できます。もっとも手短かには、
次のように定義できます。
(define-class <2d-point> () (x y))
(この節の例の定義コードは Gauche ソース配布物のなかの
examples/oointro.scm にあります。)
シンボル <2d-point> はクラスの名前です。グローバル変数
<2d-point>はクラスオブジェクトに束縛されています。クラス名を
< と > で囲むのは慣習にすぎません。define-class
には任意のシンボルを渡すことができます。
define-classの第二引数は、直接のスーパークラスのリストです。
これでこのクラスの継承を指定します。これについては後で説明します。
define-classの第三引数はスロットのリストです。
スロットはなにかを格納しておく場所で、通常は各オブジェクトに対して、値を格納できます。
これは、他のオジェクト指向言語では、フィールドとかインスタンス変数などと
呼ばれているものに似たものです。しかし、スロットは単なる各オブジェクト毎の
格納スペース以上の使い方ができます。
さて、2 次元の点のクラスを定義しましたので、点のインスタンスを生成できます。
クラスをジェネリック関数 make に渡してインスタンスを生成します。
(ジェネリック関数がどんなものであるかは気にしないで下さい。今はある特殊な
タイプの関数とだけ考えておいてください。)
(define a-point (make <2d-point>)) a-point ⇒ #<<2d-point> 0x8117570>
対話モードで gosh を使っているなら、ジェネリック関数 describe を
使って、インスタンスの内部を点検できます。
便利なので、省略形としてdという名前も定義されています。
(詳細については、gauche.interactive - インタラクティブセッション参照)
gosh> (d a-point) #<<2d-point> 0x8117570> is an instance of class <2d-point> slots: x : #<unbound> y : #<unbound>
スロットの値にアクセスあるいは値を変更するためには、それぞれ、
slot-ref および slot-set! が使えます。これらの名前は
STklos からとりました。
(slot-ref a-point 'x) ;; a-point のスロット x にアクセス
⇒ error, since slot ’x doesn’t have a value yet
(slot-set! a-point 'x 10.0) ;; a-point のスロット x を 10.0 に設定
(slot-ref a-point 'x)
⇒ 10.0
Gauche では、より短かい名前 ref も使えます。これを使えば
SRFI-17 の一般化された set! の構文が使えます。
(ref a-point 'x) ⇒ 10.0 (set! (ref a-point 'y) 20.0) (ref a-point 'y) ⇒ 20.0
スロットの値が設定されていることを見てみましょう。
gosh> (d a-point) #<<2d-point> 0x8117570> is an instance of class <2d-point> slots: x : 10.0 y : 20.0
実際には、スロットにデフォルト値を設定できたり、インスタンス生成時に
スロットに値を設定できると便利なことが多いです。このような情報は、
スロットオプションで指定できます。<2d-point>の定義を
次のように変更してみましょう。
(define-class <2d-point> () ((x :init-value 0.0 :init-keyword :x :accessor x-of) (y :init-value 0.0 :init-keyword :y :accessor y-of)))
各スロットの指定は、前の例では一つのシンボルでしたが、こんどはリスト
であることに注意してください。
こんどは、リストの car 部分がスロット名の指定で、cdr 部分にいろいろな情報が
はいります。:init-value のうしろの値はそのスロットのデフォルト値を
定義しています。:init-keywordのうしろのキーワードは、生成時にスロットを
初期化するために make に渡すことのできるキーワード引数を定義しています。
キーワード :accessor のうしろの名前は、スロットへのアクセス/変更の
ために使えるジェネリック関数に束縛されます。これは
slot-ref/slot-set! のかわりに使います。
ちょっとした対話セッションをみてみましょう。新しい <2d-point> クラスの
インスタンスをつくります。スロットがデフォルト値で初期化されているのがわかり
ますね。
gosh> (define a-point (make <2d-point>)) a-point gosh> (d a-point) #<<2d-point> 0x8148680> is an instance of class <2d-point> slots: x : 0.0 y : 0.0
こんどは、キーワード引数で初期値を与えて、別のインスタンスを作ります。
gosh> (define b-point (make <2d-point> :x 50.0 :y -10.0)) b-point gosh> (d b-point) #<<2d-point> 0x8155b80> is an instance of class <2d-point> slots: x : 50.0 y : -10.0
アクセサは slot-ref/slot-set! より短かくなって便利に
なりましたね。
gosh> (x-of a-point) 0.0 gosh> (x-of b-point) 50.0 gosh> (set! (y-of a-point) 3.33) #<undef> gosh> (y-of a-point) 3.33
利用可能な全スロットオプションのリストはクラスの定義にあります。 ちょっと見ると、これらのスロットオプションの宣言は冗長に見えるかもしれません。 システム側で初期化キーワードやアクセス名を自動的に定義する静的な仕組を 用意することもできたかもしれません。 しかしながら、CLOS 風のシステムでは柔軟性の方をより重視します。 メタオブジェクトプロトコルと呼ばれる機構をもちいて、これらの スロットオプションがどのように解釈されるかをカスタマイズすることができます。 また、自分用のスロットオプションを追加することもできます。 詳しくは メタオブジェクトプロトコル を見てください。
また、似たような流儀で <2d-vector> クラスを定義できます。
(define-class <2d-vector> () ((x :init-value 0.0 :init-keyword :x :accessor x-of) (y :init-value 0.0 :init-keyword :y :accessor y-of)))
そうです。同じアクセサ名を x-of のように使うことができます。
これは事実上、多重定義されます。
主流のオブジェクト指向言語に慣れた方は、そろそろ、メソッドはどこにあるのだと
思い始めているかもしれません。いよいよメソッドの登場です。以下のフォームは、3 つの引数
pt、dy、dy をとり、
しかもpt は <2d-point> のインスタンスであるような
メソッド move-by! を定義するものです。
(define-method move-by! ((pt <2d-point>) dx dy) (inc! (x-of pt) dx) (inc! (y-of pt) dy))
define-method マクロの第二引数はメソッド特定化子リストを
指定しています。これは、第一引数が <2d-point> のインスタンスで
なければならないことを示し、第二、第三引数は任意の型でよいことを
示しています。メソッド呼び出しの構文は通常関数の呼び出しと同じです。
gosh> (move-by! b-point 1.4 2.5) #<undef> gosh> (d b-point) #<<2d-point> 0x8155b80> is an instance of class <2d-point> slots: x : 51.4 y : -7.5
別の特定化子によりこのメソッドを多重定義することが可能です。以下のように ベクタを使って点を動かすこともできます。
(define-method move-by! ((pt <2d-point>) (delta <2d-vector>)) (move-by! pt (x-of delta) (y-of delta)))
特定化はユーザ定義のクラスにだけ限定されているわけではありません。 Gauche の組み込み型を使ってメソッドを特定化することもできます。
(define-method move-by! ((pt <2d-point>) (c <complex>)) (move-by! pt (real-part c) (imag-part c)))
以下はセッション例です。
gosh> (define d-vector (make <2d-vector> :x -9.0 :y 7.25)) d-vector gosh> (move-by! b-point d-vector) #<undef> gosh> (d b-point) #<<2d-point> 0x8155b80> is an instance of class <2d-point> slots: x : 42.4 y : -0.25 gosh> (move-by! b-point 3+2i) #<undef> gosh> (d b-point) #<<2d-point> 0x8155b80> is an instance of class <2d-point> slots: x : 45.4 y : -2.25
メソッドがその主レシーバ <2d-point> によってのみディスパッチされる
のではなく、その他の引数によってもディスパッチされているのがわかると思います。
実は、第一引数は残りの引数に比べて何ら特別ではありません。
CLOS 風のシステムではメソッドは特定のクラスに属するものではないのです。
ではメソッドとはいったいなんでしょう。move-by! を点検してみると
それが <generic> のインスタンスであり、ジェネリック関数であると
わかります。(describe は可読性のために methods スロットの
値の印字を途中で切っていることに注意してください。)
gosh> move-by! #<generic move-by! (3)> gosh> (d move-by!) #<generic move-by! (3)> is an instance of class <generic> slots: name : move-by! methods : (#<method (move-by! <2d-point> <complex>)> #<method (move- gosh> (ref move-by! 'methods) (#<method (move-by! <2d-point> <complex>)> #<method (move-by! <2d-point> <2d-vector>)> #<method (move-by! <2d-point> <top> <top>)>)
ジェネリック関数は特別なタイプの関数だと言いましたが、Gauche ではこれは 適用可能オブジェクトとして認識されます。それは、適用されるとその引数に 対応して適切なメソッドを選択して、その選択されたメソッドを呼び出すという動作を 行います。
実際 define-method マクロがやっていることは、(1)もし与えられた
名前のジェネリック関数がまだ存在していなければ、これを生成し、(2)与えられた
特定化子と本体とでメソッドオブジェクトを生成し、(3)ジェネリック関数に
そのメソッドオブジェクトを追加する、ということです。
アクセサも同様にジェネリック関数で、define-class マクロが暗黙のうちに
生成します。
gosh> (d x-of) #<generic x-of (2)> is an instance of class <generic> slots: name : x-of methods : (#<method (x-of <2d-vector>)> #<method (x-of <2d-point>)>)
主流の動的オジェクト指向言語では、クラスには多くの役割があります。 クラスは構造と型を定義し、スロットとメソッドの名前空間を生成し、 メソッドのディスパッチに責任をもちます。Gaucheでは、名前空間は モジュールによって管理し、メソッドのディスパッチはジェネリック関数で あつかいます。
オブジェクトの印字表現は、デフォルトでは、あまりユーザにやさしくありません。
Gauche の write および display 関数は、どのように印字して
よいかわからないインスタンスにであうと、ジェネリック関数 write-object
を呼びます。定義したクラスのインスタンスをどのように印字するかを
カスタマイズするために、そのクラスに特定したメソッドを定義することができます。
(define-method write-object ((pt <2d-point>) port) (format port "[[~a, ~a]]" (x-of pt) (y-of pt))) (define-method write-object ((vec <2d-vector>) port) (format port "<<~a, ~a>>" (x-of vec) (y-of vec)))
で、どうなったかというと、
gosh> a-point [[0.0, 3.33]] gosh> d-vector <<-9.0, 7.25>>
SRFI-10 のフォーマットを満すように印字表現をカスタマイズし、読み込み時 構築子を定義すれば、自分の定義したクラスのインスタンスを、組み込み オブジェクトと同様に書き出し、読み戻しできます。詳しくは 読み込み時コンストラクタ を見てください。
いくつかの組み込み関数はユーザ定義オブジェクトに対して同様の方法で
機能拡張できます。たとえば、object-equal? を特定化すれば、
equal? を使ってインスタンスの比較ができます。
(define-method object-equal? ((a <2d-point>) (b <2d-point>))
(and (equal? (x-of a) (x-of b))
(equal? (y-of a) (y-of b))))
(equal? (make <2d-point> :x 1 :y 2) (make <2d-point> :x 1 :y 2))
⇒ #t
(equal? (make <2d-point> :x 1 :y 2) (make <2d-point> :x 2 :y 1))
⇒ #f
(equal? (make <2d-point> :x 1 :y 2) 'a)
⇒ #f
(equal? (list (make <2d-point> :x 1 :y 2)
(make <2d-point> :x 3 :y 4))
(list (make <2d-point> :x 1 :y 2)
(make <2d-point> :x 3 :y 4)))
⇒ #t
もっとおもしろい例を見てみましょう。描画可能な <shape> というクラス
を考えます。
基本クラスとして、色や線の太さといった共通属性をスロットに持たせます。
(define-class <shape> () ((color :init-value '(0 0 0) :init-keyword :color) (thickness :init-value 2 init-keyword :thickness)))
インスタンスを生成する際、make はジェネリック関数 initialize
を呼びます。この関数は init-keyword や init-value を処理するようなスロットの
面倒を見ます。この initialize メソッドを特定化することによって、初期化
の振舞いをカスタマイズすることができます。initialize メソッドは二つの
引数とともに呼ばれます。ひとつは新しく生成されたインスタンス、もうひとつは
make にわたされた引数のリストです。
initialize メソッドを <shape> クラス用に定義し、生成された
shape が自動的にグローバルなリストに登録されるようにしましょう。
システムのもつ initialize の振舞いを完全に置き換えたくはないという
ことに注意してください。init-keyword は相変わらず扱う必要があるからです。
(define *shapes* '()) ;; グローバルな shape のリスト (define-method initialize ((self <shape>) initargs) (next-method) ;; このシステムがスロットの初期化処理をするようにする (push! *shapes* self)) ;; 自分自身をグローバルなリストに登録する
仕掛けは、特別なメソッド next-method にあります。これは
メソッド本体の中でしか使えません。同じジェネリック関数の
特定化の度合がより低いメソッドを呼びます。これは、典型的には
スーパークラスの同じメソッドを呼ぶということを意味します。
ほとんどのオジェクト指向言語には、スーパークラスのメソッドを呼ぶという
概念があります。多重引数ディスパッチと多重継承のために next-method
は少し複雑にはなっていますが、基本的なアイディアは同じです。
さて、では <shape> のスーパークラスはなんでしょう。実は、
すべての Scheme で定義されたクラスは <object> というクラスを
継承します。スロットのめんどうを見ているのは、<object> の
初期化メソッドなのです。自分で定義した initialize メソッド中で
next-method を呼びだしたあとでは、すべてのスロットが
正しくイニシャライズされたとみなせます。というわけで、自分で定義した
initialize のなかで通常、最初にすべきことは next-method
を呼ぶことです。
上のコードを点検してみましょう。(make <shape> args …) を呼ぶと、
システムは <shape> のインスタンスのためのメモリを確保し、
initialize ジェネリック関数を、そのインスタンスと args …
で呼びます。これは、いま自分で定義した initialize にディスパッチ
されます。その中で next-method よび、それがこんどは <object>
クラスの initialize メソッドをよびます。これでこのインスタンスは
init-value と init-keyword で初期化されます。next-method からもどった
あと、新しい <shape> インスタンスをグローバルの shape リストに
*shapes* に登録します。
この <shape> クラスは shape の抽象的概念を表現しているにすぎません。
では、いくつかの具体的な描画可能な shape を <shape> の
サブクラス化によって定義しましょう。
(define-class <point-shape> (<shape>) ((point :init-form (make <2d-point>) :init-keyword :point))) (define-class <polyline-shape> (<shape>) ((points :init-value '() :init-keyword :points) (closed :init-value #f :init-keyword :closed)))
define-class の第二引数に注目してください。これは
<point-shape> および <polyline-shape> が <shape>
クラスのスロットを継承していることを示しています。そして <shape>
クラスが受け入れるものはすべて、それらのサブクラスでも受け入れらること
も示しています。
<point-shape> には point というスロットがひとつ追加
されています。このスロットはこの節の最初で定義した、<2d-point> の
インスタンスを持ちます。<polyline-shape> クラスは点のリスト、
フラグを格納します。フラグは多角形のラインが終点と始点つないでいるか
どうかを指定します。
継承はとりあつかいに注意が必要な強力な機構です。うっかりするとすぐに
追跡不能なコードができあがります。(Paul Graham は『百年の言語』という
記事のなかで、「オブジェクト指向プログラミングはスパゲッティコードを
書くための持続的な方法を提供してくれる。」と言っているように。)
経験則からいうとサブタイプが必要なときにサブクラスを作るのがよいようです。
スロットの継承は付随するなにかではありますが、サブクラス化のための
主要な理由にしてはいけません。<point-shape> クラスでやったように
サブストラクチャを「インクルード」することは常にできるのです。
<point-shape> クラスに新しいスロットオプションがあらわれました。
:init-form というスロットオプションは、init-keyword が
make に与えられなかったときのそのスロットのデフォルト値を指定します。
しかし、クラス定義時に評価される :init-value の値とはちがって、
この :init-form をともなう値はシステムが実際のその値を必要とした
ときに評価されます。したがって、<point-shape> のインスタンス
では、<point-shape> インスタンスが :point キーワード引数を
わたされずに生成されたときにのみ、デフォルトの <2d-point>
インスタンスが生成されます。
shape は別のデバイスに別の方法で描画され得ます。いまのところは、
PostScript 出力だけを考慮しましょう。draw メソッドに多相性を持たせる
ために、PostScript 出力デバイス <ps-device> を定義します。
(define-class <ps-device> () ())
こうすると、<shape> および <ps-device> の両方に特定化した
draw メソッドを書くことができます。
(define-method draw ((self <shape>) (device <ps-device>)) (format #t "gsave\n") (draw-path self device) (apply format #t "~a ~a ~a setrgbcolor\n" (ref self 'color)) (format #t "~a setlinewidth\n" (ref self 'thickness)) (format #t "stroke\n") (format #t "grestore\n"))
このコードでは device 引数はメソッド本体内では使われていません。
メソッドディスパッチのためのみに使われます。いずれ別の出力デバイス
を必要になったら、そのデバイスに特定化した draw メソッドを
追加することができます。
上の draw メソッドは共通の仕事をしますが、実際の描画は
それぞれのサブクラス用に特定化された方法で行わなければなりません。
(define-method draw-path ((self <point-shape>) (device <ps-device>))
(apply format #t "newpath ~a ~a 1 0 360 arc closepath\n"
(point->list (ref self 'point))))
(define-method draw-path ((self <polyline-shape>) (device <ps-device>))
(let ((pts (ref self 'points)))
(when (>= (length pts) 2)
(format #t "newpath\n")
(apply format #t "~a ~a moveto\n" (point->list (car pts)))
(for-each (lambda (pt)
(apply format #t "~a ~a lineto\n" (point->list pt)))
(cdr pts))
(when (ref self 'closed)
(apply format #t "~a ~a lineto\n" (point->list (car pts))))
(format #t "closepath\n"))))
;; utility method
(define-method point->list ((pt <2d-point>))
(list (x-of pt) (y-of pt)))
最後にもう少しだけ、ハックしましょう。draw メソッドを
shape のリストに対しても動作するようにします。こうすれば、
同一ページ内で複数の shape をひつまとめで描画できます。
(define-method draw ((shapes <list>) (device <ps-device>)) (format #t "%%\n") (for-each (cut draw <> device) shapes) (format #t "showpage\n"))
これで簡単な図を書けるようになります。
(use math.const) ;; for constant pi
(define (shape-sample)
;; creates 5 corner points of pentagon
(define (make-corners scale)
(map (lambda (i)
(let ((pt (make <2d-point>)))
(move-by! pt (make-polar scale (* i 2/5 pi)))
(move-by! pt 200 200)
pt))
(iota 5)))
(set! *shapes* '()) ;; clear the shape list
(let* ((corners (make-corners 100)))
;; a pentagon in green
(make <polyline-shape>
:color '(0 1 0) :closed #t
:points corners)
;; a star-shape in red
(make <polyline-shape>
:color '(1 0 0) :closed #t
:points (list (list-ref corners 0)
(list-ref corners 2)
(list-ref corners 4)
(list-ref corners 1)
(list-ref corners 3)))
;; put dots in each corner of the star
(for-each (cut make <point-shape> :point <>)
(make-corners 90))
;; draw the shapes
(draw *shapes* (make <ps-device>)))
)
関数 shape-sample は現在の出力ポートに簡単な PostScript の描画コード
を書き出します。これを以下のような式でファイルに出力し、GhostScriptなどの
PostScriptビューワで結果を見てください。
(with-output-to-file "oointro.ps" shape-sample)