#:g1: MOPを活用するユーティリティを眺める(3): mop-utils

Posted 2013-12-22 10:30:00 GMT

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

 Metaobject Protocol(MOP) Advent Calendar 2013 22日目です。
MOPを活用するユーティリティを眺めるの三回目。今回は、mop-utilsを眺めてみたいと思います。

mop-utilsとは

 mop-utils はRyszard Szopa氏作のMOP系のユーティリティ集です。
元々は、O/RマッパーのSubmarineを作成する際に必要となったものをまとめたものとのこと

mop-utilsを眺める

 では、mop-utilsを早速眺めていきましょう。
動作確認用にクラスを定義しておきます。

(defclass counted-class-slot-definition ()
  ((foo :initform nil :initarg :foo)))

(defmetaclass counted-class (standard-class) ((counter :initform 0)) (:validate-superclasses standard-class) (:slot-fixtures counted-class-slot-definition))

(defclass foo-counted () ((x :initform 42)) (:metaclass counted-class))

(defclass bar-counted (foo-counted) ((x :initform 84)) (:metaclass counted-class))

defmetaclass

(defmetaclass counted-class (standard-class)
  ((counter :initform 0))
  (:validate-superclasses standard-class)
  (:slot-fixtures counted-class-slot-definition))

 メタクラスを定義する時に便利なマクロで、一連の作業をまとめたものです。
:validate-superclassesや:slot-fixturesを指定することで、DIRECT-SLOT-DEFINITION-CLASSや、EFFECTIVE-SLOT-DEFINITION-CLASSの定義も一緒にできます。

スロット定義は、予め

(defclass counted-class-slot-definition ()
  ((foo :initform nil :initarg :foo)))

等々のように定義済みであることが前提となっています。
上記のdefmetaclassのマクロ展開は、

(PROGN
 (DEFCLASS COUNTED-CLASS (STANDARD-CLASS) ((COUNTER :INITFORM 0)))
 (DEFCLASS COUNTED-CLASS-DIRECT-SLOT-DEFINITION
           (SB-MOP:STANDARD-DIRECT-SLOT-DEFINITION
            COUNTED-CLASS-SLOT-DEFINITION)
           NIL)
 (DEFCLASS COUNTED-CLASS-EFFECTIVE-SLOT-DEFINITION
           (SB-MOP:STANDARD-EFFECTIVE-SLOT-DEFINITION
            COUNTED-CLASS-SLOT-DEFINITION)
           NIL)
 (DEFMETHOD SB-MOP:DIRECT-SLOT-DEFINITION-CLASS
            ((CLASS COUNTED-CLASS) &REST MOP-UTILS::INITARGS)
   (DECLARE (IGNORE MOP-UTILS::INITARGS))
   (FIND-CLASS 'COUNTED-CLASS-DIRECT-SLOT-DEFINITION))
 (DEFMETHOD SB-MOP:EFFECTIVE-SLOT-DEFINITION-CLASS
            ((CLASS COUNTED-CLASS) &REST MOP-UTILS::INITARGS)
   (DECLARE (IGNORE MOP-UTILS::INITARGS))
   (FIND-CLASS 'COUNTED-CLASS-EFFECTIVE-SLOT-DEFINITION))
 (DEFMETHOD SB-MOP:VALIDATE-SUPERCLASS
            ((CLASS COUNTED-CLASS) (MOP-UTILS::SUPERCLASS STANDARD-CLASS))
   T)
 (FIND-CLASS 'COUNTED-CLASS))

 のような感じ。そのままですね。

class-name-of

(class-name-of (make-instance 'foo-counted))
;=>  FOO-COUNTED

 クラス名を取得するもの。moptilities:class-name-of と同じですね。

slot-names-of

(slot-names-of (make-instance 'foo-counted))
;=>  (X)

 スロット名一覧を取得するもの。これは、moptilities:slot-names と同じですね。

slots-of

(slots-of (make-instance 'foo-counted))
;=>  (#<COUNTED-CLASS-EFFECTIVE-SLOT-DEFINITION X>)

 スロット一覧を取得するもの。c2mop:class-slotsのインスタンスから情報を取得する版

get-slot-by-name

(get-slot-by-name (find-class 'foo-counted) 'x)
;=>  #<COUNTED-CLASS-EFFECTIVE-SLOT-DEFINITION X>

 クラスからスロット一覧を取得するもの

get-slot-of-by-name

(get-slot-of-by-name (make-instance 'foo-counted) 'x)
;=>  #<COUNTED-CLASS-EFFECTIVE-SLOT-DEFINITION X>

 get-slot-by-nameのインスタンスから情報を取得する版

do-children

(do-children (c foo-counted)
  (print (get-slot-by-name c 'x)))
;>>  
;>>  #<COUNTED-CLASS-EFFECTIVE-SLOT-DEFINITION X> 
;=>  NIL

 ダイレクトサブクラスに対してまとめて何かを実行するもの
class-direct-subclassesの結果がマクロ展開に埋め込まれてるのは、あまり良くないような

do-macro-for-children

(do-macro-for-children prin1-macro foo-counted)
;>>  BAR-COUNTED
;=>  NIL

 do-childrenで要素にマクロを適用するというもの。怪しい。
展開はこんな感じ

(DO-CHILDREN (#:|child2943| FOO-COUNTED)
  (LET ((#:|child-name2944| (CLASS-NAME #:|child2943|)))
    (EVAL `(PRIN1-MACRO ,#:|child-name2944|))))

まとめ

 今回はmop-utilsを眺めてみました、
MOP Advent Calendarもあと3日。尻切れトンボ気味ですが、あと3日書けそうなネタを探します。

comments powered by Disqus