オブジェクトシステムの紹介 (Gauche ユーザリファレンス)

7.1 オブジェクトシステムの紹介

この節では 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)