#:g1: MOPでスロットのチェック

Posted 2013-12-15 15:00:00 GMT

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

 Metaobject Protocol(MOP) Advent Calendar 2013 16日目です。
今回は、CLOSで契約プログラミングについて書こうと思っていましたが、紹介する筈のプログラムを良く読んだら、あまりMOPを使ってなかったので、近いところで、Gaucheの<validator-meta>を眺めてみたいと思います。

Gaucheの<validator-meta>とは

 クラスのスロットの書き込み時に実行する関数を指定できるというメタクラスです。GoFでいうObserverのスロット版というところですが、詳細は、マニュアルに記載されていますので参照して下さい。

<validator-meta>を眺める

 さて<validator-meta>がどんな感じに実装されているのか。ソースの場所を確認すると lib/gauche/mop/validator.scm にあります。

(define-class <validator-meta> (<class>)
  ())

(define-method compute-get-n-set ((class <validator-meta>) slot) (let ((pre (slot-definition-option slot :validator #f)) (post (slot-definition-option slot :observer #f))) (if (or pre post) (let* ((acc (compute-slot-accessor class slot (next-method))) (getter (lambda (o) (slot-ref-using-accessor o acc))) (bound? (lambda (o) (slot-bound-using-accessor? o acc))) (setter (cond ((and pre post) (lambda (o v) (slot-set-using-accessor! o acc (pre o v)) (post o (slot-ref-using-accessor o acc)))) (pre (lambda (o v) (slot-set-using-accessor! o acc (pre o v)))) (else (lambda (o v) (slot-set-using-accessor! o acc v) (post o (slot-ref-using-accessor o acc))))))) ;; the last #t enables initialization by :initform etc. (list getter setter bound? #t)) (next-method))))

;; convenience base class. you can either inherit <validator-mixin>, ;; or specifying :metaclass <validator-meta> to your class. (define-class <validator-mixin> () () :metaclass <validator-meta>)

 なんと正味20行程で定義されています。早速読んでいきましょう。自分の場合、頭の中で想像するのが苦手なのでコード辺をREPLで実行しつつ確認していきます。

compute-get-n-set のカスタマイズ

 <validator-meta>の定義のメインは、compute-get-n-setですが、これはスロットのアクセサを計算するもので、これをオーバライドしています。
カスタマイズされた compute-get-n-set の中身を実行しつつ確認してみましょう。

slot-definition-option

 まず出会うのが、slot-definition-option ですが、ここでスロットのオプションを取得しているようです。確認用のメタクラスを定義してslot-definition-optionの動作を確認してみます。

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

(define-class <bar> () ((x :foo "foo") (y :foo "bar") (z :foo "baz")) :metaclass <foo>)

(map (lambda (s) (slot-definition-option s :foo #f)) (class-slots (class-of (make <bar>)))) ;=> ("foo" "bar" "baz")

スロットオプションとして与えた:fooの値が取れるようですね。
ということで、:validatorと:observerに指定した値がpre/postに格納されます。
preもpostもなければnext-methodで上位メソッドに丸投げで通常どおりの動作。

compute-slot-accessor

 次にcompute-slot-accessorですが、スロットのアクセサを割り出すメソッドです。


(let* ((class <bar>)
       (slot (ref (class-slots class) 0)))
  (compute-slot-accessor class
                         slot
                         (compute-get-n-set class slot)))
;=> #<slot-accessor <bar>.x 0>

このアクセサ経由で、

を使ってスロットの読み書きと束縛されているかを知ることができます。
読み出しと、束縛のチェックは、そのまま。
セッタの定義でpreとpostで取得した:validatorと:observerに指定した関数が実行されるようにしています。

<validator-mixin>

 CLOSでは、metaclassはいちいち指定しなければいけないのですが、Gaucheの場合は、メタクラスを指定したクラスを継承することで、すっきり書けます。
<validator-mixin>は、そんな感じで使うためのmixin用クラスです。

使ってみる

(define-class <dbc-test> (<validator-mixin>)
  ((slot1 :accessor slot1 :init-keyword :slot1 :init-value 0
          :validator (lambda (s v) 
                       (format #t " >> Invariant check for class ~A~%" s)
                       (if (number? v)
                           v
                           (error "Invariant violation after class creation: " s)))
          :observer (lambda (s v)
                      (format #t " :slot1 => ~A~%" v)))))

(make <dbc-test> :slot1 1) ;;>>> >> Invariant check for class #<<dbc-test> 0x8be220> ;=> #<<dbc-test> 0x8be220> (make <dbc-test> :slot1 'x) ;;>>> >> Invariant check for class #<<dbc-test> 0x8bfd60> ;=> *** ERROR: Invariant violation after class creation: #<<dbc-test> 0x8bfd60> (let ((o (make <dbc-test>))) (slot1 o)) ;>>> >> Invariant check for class #<<dbc-test> 0x85f7a0> ;>>> :slot1 => 0 ;=> 0

まとめ

 Common Lispで書くなら、アクセサに:beforeと:afterを付けるというところでしょうか。しかし、slot-definition-optionのような便利関数がないのでクラスの定義側が面倒そうです。
マクロでやってしまえばOKといえばOKですが、MOPで綺麗にまとめたいところでしょう。

 MOP Advent Calendarも残すところあと10日を切りましたが参加者募集中です。MOPネタならどんなネタでもOKです!

comments powered by Disqus