2013/12/03

gauche.recordとMOP

(Metaobject Protocol(MOP) Advent Calendar 2013参加エントリ)

自分はもともとクラスベースオブジェクト指向よりは クロージャによる抽象化を好むこともあって、 MOPをバリバリ使って新しいオブジェクトシステムを実験する、 みたいなことはあまりやらない。

なのでMOPの使いどころは主に 「もともとのシステムからはちょっぴり外れた仕様を実現したい」というケースだ。 今回もそういう、ちょっとした小技で仕様の違いを吸収した話。

＊ ＊ ＊

さて、C言語の構造体にあたるものは、Schemeではレコードという。 Gaucheのレコード型はsrfi-99 (SRFI:99) で定義されたものの拡張で、 gauche.record モジュールをuseすると使える。

例えばこれが、フィールドx, y, zを持つpoint型の定義。

(define-record-type point #t #t
  x y z)

コンストラクタやアクセサは自動的に定義される (必要なら名前をカスタマイズ することもできる)。

gosh> (define p (make-point 1 2 3))
p
gosh> p
#<point 0x2976de0>
gosh> (point? p)
#t
gosh> (point-x p)
1
gosh> (point-z p)
3

デフォルトではフィールドはimmutableだが、mutableなフィールドを 定義することもできる。

さて、Gaucheにはもともと、複数のフィールド(スロット)を持つ構造的なデータを 定義する方法として、組み込みのクラスシステムがある。であれば、レコード型も クラスにマップするのが素直だろう。実際、レコード型 point は Gaucheのクラスに束縛されている。

gosh> (describe point)
#<class point> is an instance of class <record-meta>
slots:
  field-specs: #((immutable x) (immutable y) (immutable z))
  name      : point
  cpl       : (#<class point> #<class <record>> #<class <object>> #<class 
  direct-supers: (#<class <record>> #<class <object>>)
  accessors : ((x . #<slot-accessor point.x proc>) (y . #<slot-accessor po
  slots     : ((x :immutable #t :index 0) (y :immutable #t :index 1) (z :i
  direct-slots: ((x :immutable #t :index 0) (y :immutable #t :index 1) (z :i
  num-instance-slots: 3
  direct-subclasses: (#<class mutable-point>)
  direct-methods: ()
  initargs  : (:name point :field-specs #((immutable x) (immutable y) (imm
  defined-modules: ()
  redefined : #f
  category  : scheme

pointのインスタンスもGaucheのインスタンスとして使える。

gosh> (~ p 'x)
1
gosh> (slot-ref p 'y)
2

ただ、レコード定義をそのままクラス定義に置き換えると、ちと困ったことが起きる。 継承がある場合だ。

srfi-99レコードは単一継承を許している。例えば上記 point を継承して colored-point を定義できる。

(define-record-type (colored-point point) #t #t
  r g b)

gosh> (define cp (make-colored-point 1 2 3 0.5 0.5 0.9))
cp
gosh> (describe cp)
#<colored-point 0x2a89bc0> is an instance of class colored-point
slots:
  r         : 0.5
  g         : 0.5
  b         : 0.9
  x         : 1
  y         : 2
  z         : 3

ここで、サブクラスに、親クラスのフィールドと同名のフィールドを定義したら どうなるか。Gaucheのクラスでは、CLOSと同様に、同名のフィールドはマージされる。 親と子がともにfooという名前のスロットを定義していたら、インスタンスには foo用のスロットはひとつしか定義されない。 (このことを利用して、子クラスで親クラスのスロットオプションをオーバライドできる。)

レコード型では、親レコードの構造を保ったまま、子レコードのスロットが追加される。 次の例を参照。

(define-record-type (colored-point2 point) #t #t
  c m y k)

yというスロット名が重複しているが、親のyと子のyは区別される。 スロット名でアクセスすると子クラスのスロットしか見えないが、 アクセサを使えば親クラスのスロットにもアクセスできる。

gosh> (define cp (make-colored-point2 1 2 3 0.5 0.5 0.8 0.1))
cp
gosh> (~ cp 'y)
0.8
gosh> (colored-point2-y cp)
0.8
gosh> (point-y cp)
2

マクロで define-record-type から define-class に 変換する時にぶつかる名前をリネームしてやって… というふうにも出来るが、 名前の管理が煩わしい。MOPならわずかのコードでこの変更が書ける。

継承関係から、クラスclassのインスタンスが持つべきスロットを 計算するメソッドがcompute-slotsだ。組み込みのクラスでは ここで重複スロット名をチェックしている。レコード型については、 スロット名をチェックせずに単純に先祖のクラスのスロットを足してゆけば良い。

(define-method compute-slots ((class <record-meta>))
  (fold (^[c r] (append (slot-ref c'direct-slots) r))
        '() (reverse (slot-ref class'cpl))))

クラスの継承リストをreverseしているのは、子クラスのスロットの方が 定義で先に来るようにするためだ。こうすると、Gaucheインスタンスとして スロット名でアクセスした場合に、子クラスのスロットが優先される。

定義中ではクラスのスロットの順番を入れ替えたが、 インスタンス中のスロットの配置は親クラスの方を先に持ってきたい。 なぜならcolored-point2のインスタンスをpointとして アクセスした場合には親クラスの構造が見えて欲しいからだ。 そのため、スロットアクセサを計算する compute-get-n-set メソッドを オーバライドする。

(define-method compute-get-n-set ((class <record-meta>) slot)
  (next-method)
  (let1 s
      (compute-slot-accessor class slot (slot-definition-option slot :index))
    (if (slot-definition-option slot :immutable #f)
      `(,(^o (slot-ref-using-accessor o s))
        ,(^[o v] (errorf "slot ~a of ~a is immutable"
                         (slot-definition-name slot) o))
        ,(^o (slot-bound-using-accessor? o s)))
      s)))

:index オプションはインスタンス先頭からのスロットのオフセット。 レコード型を生成する make-rtd 手続き中で計算される。

compute-slot-accessor にこのオフセットを渡すことで、このスロットへの アクセス＝インスタンスの該当オフセットにあるメモリの読み書き、という動作になる。

(slot-definition-option slot :immutable #f) 以下の部分は immutableなスロットを実現するトリックで、セッター手続きが呼ばれた場合に エラーを投げる。

gauche.recordのソースは他にも色々やっているが、 効率のためになるべくインライン展開されるようにごちゃごちゃ工夫しているだけで、 レコード型からクラスへのadaptationの本質はこのMOP部分だけだ。

Tags: Programming, Gauche, MOP, CLOS, gauche.record