Common Lispであるクラスのサブクラス全てを欲しかった。 というかmito:dao-table-classのサブクラス全てのが欲しかったが、具体的に分からなかったのでメモ。
前提条件として、Common Lisp Object Systemと呼ばれるクラスシステムが標準であるが、このCLOSを実現するためにMetaobject Protocolと呼ばれるさらに抽象的なライブラリが用いられるらしい。 このMOPの機能を利用すれば、全サブクラスを取得できる、はず。
Closer to MOPを使う
まずクラスオブジェクトが必要なので、find-classでクラス名のシンボルからクラスのオブジェクトを取得する。 それをMOPの関数に渡したりするが、MOP自体は言語の標準ではないため互換性の観点から Closer to MOP を使用する。
例えばclass-direct-subclassesであれば、
(ql:quickload :closer-mop) (defclass alfa () ()) (defclass bravo (alfa) ())
とすると、alfaは継承されてるからbravoが返る。
(closer-mop:class-direct-subclasses (find-class 'alfa))
(#<STANDARD-CLASS COMMON-LISP-USER::BRAVO>)
bravoは継承されてないからnil。
(closer-mop:class-direct-subclasses (find-class 'alfa))
NIL
Mitoのテーブル
(ql:quickload :mito) (defclass charlie () ((delta :col-type (:varchar 64) :accessor charlie-delta) (echo :col-type (or (:varchar 128) :null) :accessor charlie-echo)) (:metaclass mito:dao-table-class))
#<MITO.DAO.TABLE:DAO-TABLE-CLASS COMMON-LISP-USER::CHARLIE>
とりあえず今は末端のクラスは分かってるので、継承関係を比較する。
alfa の compute-class-precedence-list
(closer-mop:compute-class-precedence-list (find-class 'alfa))
(#<STANDARD-CLASS COMMON-LISP-USER::ALFA> #<STANDARD-CLASS COMMON-LISP:STANDARD-OBJECT> #<SB-PCL::SLOT-CLASS SB-PCL::SLOT-OBJECT> #<SB-PCL:SYSTEM-CLASS COMMON-LISP:T>)
charlie の compute-class-precedence-list
(closer-mop:compute-class-precedence-list (find-class 'charlie))
(#<MITO.DAO.TABLE:DAO-TABLE-CLASS COMMON-LISP-USER::CHARLIE> #<MITO.DAO.MIXIN:DAO-TABLE-MIXIN MITO.DAO.MIXIN:SERIAL-PK-MIXIN> #<STANDARD-CLASS MITO.DAO.TABLE:DAO-CLASS> #<MITO.DAO.MIXIN:DAO-TABLE-MIXIN MITO.DAO.MIXIN:RECORD-TIMESTAMPS-MIXIN> #<STANDARD-CLASS COMMON-LISP:STANDARD-OBJECT> #<SB-PCL::SLOT-CLASS SB-PCL::SLOT-OBJECT> #<SB-PCL:SYSTEM-CLASS COMMON-LISP:T>)
mixinは無視されるのでdao-classのサブクラスを取ると、
(closer-mop:class-direct-subclasses (find-class 'mito:dao-class))
(#<MITO.DAO.TABLE:DAO-TABLE-CLASS COMMON-LISP-USER::CHARLIE>)
となり元々欲しかったdao-table-classの一覧が取れた。 dao-table-classのサブクラスじゃなくて、メタクラスがdao-table-classだったの最初勘違いしてたが。
