#:g1: STklosのメタクラス継承(をCommon Lispで)

Posted 2019-11-17 15:55:00 GMT

前回は、ECLOSが提供するdefclass:metaclassオプション省略時のメタクラスの自動算出について書きましたが、今回はTiny CLOSの流れを汲むSTklos系のメタクラスメタクラスの自動算出です。

Tiny CLOSが動くScheme処理系は結構あるようですが、より処理系と統合されたり構文が改良されたりしているのがSTklos系のようです。

上記あたりがSTklos系のようですが、Tiny CLOSの系譜をいまいち把握できていないので外しているかもしれません。
上記の継承関係は、

(defclass stklos (tiny-clos clos dylan) ())
(defclass guile (stklos) ())
(defclass gauche (stklos guile) ())
(defclass sagitarius (gauche) ())

っぽいですが。

とりあえず、今回のメタクラスの自動算出に関しては、上記処理系で共通なのでSTklos系ということにしましょう。

STklosメタクラスの自動算出アルゴリズム

Gauche: 7.5.1 クラスのインスタンシエーション等に解説されていますが、

  1. define-class:metaclassが明示されていればそれを使う
  2. 指定がなければ

    • ダイレクトスーパークラスのメタクラスのクラス順位リスト中を調べて
    • メタクラスが一つに定まればそれを使う
    • 複数なら、その複数のメタクラスをスーパークラスとするメタクラスを生成して使う

となります。

メタクラスのクラス順位リスト中をどう調べるのかは、コードは簡単なので詳細はコードを眺めた方が早いでしょう。
下記は、GuileのコードをCommon Lispに移植したものです。

オリジナルではクラス名をgensymで生成していますが、下記ではスーパークラス名のリストを名前としてみています。

(defpackage "d65706d7-0478-5a48-b39b-0dd8c0ff2563"
  (:use :c2cl))

(in-package "d65706d7-0478-5a48-b39b-0dd8c0ff2563")

(let ((table-of-metas '())) (defun ensure-metaclass-with-supers (meta-supers) (let ((entry (assoc meta-supers table-of-metas :test #'equal))) (if entry ;; Found a previously created metaclass (cdr entry) ;; Create a new meta-class which inherit from "meta-supers" (let* ((name (mapcar #'class-name meta-supers)) (new (make-instance 'standard-class :name name :direct-superclasses meta-supers :direct-slots '()))) (setf (find-class name) new) (push (cons meta-supers new) table-of-metas) new)))))

(defun ensure-metaclass (supers) (if (endp supers) (find-class 'standard-class) (let* ((all-metas (mapcar #'class-of supers)) (all-cpls (mapcan (lambda (m) (copy-list (cdr (class-precedence-list m)))) all-metas)) (needed-metas '())) ;; Find the most specific metaclasses. The new metaclass will be ;; a subclass of these. (mapc (lambda (meta) (when (and (not (member meta all-cpls)) (not (member meta needed-metas))) (setq needed-metas (append needed-metas (list meta))))) all-metas) ;; Now return a subclass of the metaclasses we found. (if (endp (cdr needed-metas)) (car needed-metas) ; If there's only one, just use it. (ensure-metaclass-with-supers needed-metas)))))

(defpackage stklos (:use) (:export defclass))

(defmacro stklos:defclass (name superclasses slots &rest class-options) (let* ((metaclass (ensure-metaclass (mapcar (lambda (s) (or (find-class s nil) (make-instance 'standard-class :name s))) superclasses))) (metaclass (case (class-name metaclass) (forward-referenced-class (find-class 'standard-class)) (otherwise metaclass)))) (clos::expand-defclass (class-prototype metaclass) (class-name metaclass) name superclasses slots class-options)))

動作確認

定義できたので動作を確認していきます。

(defclass a-class (standard-class) ())
(defclass b-class (standard-class) ())
(defclass c-class (a-class b-class) ())
(defmethod validate-superclass ((c a-class) (s standard-class)) T)
(defmethod validate-superclass ((c b-class) (s standard-class)) T)

(defconstant <a> (defclass a () () (:metaclass a-class)))

(defconstant <b> (defclass b () () (:metaclass b-class)))

前回と同じく、a-classb-classc-classとメタクラスを定義し、a-classをメタクラスとしたab-classをメタクラスとしたbを作成します。

ここで、

(defclass c (a b)
  ())

とした場合に、cのメタクラスがどのように求まるかを確認してみます。

(ensure-metaclass (list <a> <b>))
→ #<standard-class (a-class b-class) 42E014EC0B> 

ECLOSではc-classが算出されましたが、STklosでは新たにメタクラスが生成されています。
なお、一度生成されたメタクラスはensure-metaclass-with-supersが保持していて、同様のメタクラスの組み合わせが既に存在すれば、それが使われるので重複して生成することはありません。

(defconstant <c>
  (stklos:defclass c (a b)
    ()))

(defconstant <d> (stklos:defclass d (a b) ()))

(class-name (class-of <c>))(a-class b-class)

(class-name (class-of <d>))(a-class b-class)

(eq (class-of <c>) (class-of <d>)) → t

(find-class (class-name (class-of <d>))) → #<standard-class (a-class b-class) 42E014EC0B>

まとめ

今回は、STklos系のメタクラスの自動算出を眺めてみました。
メタクラスのサブクラス方向を探しに行くECLOSとは違って、STklosは継承の最下層になっているメタクラスを集め、複数なら合成して返す、という感じでした。

ちょっと試してみた感じでは、開発時のようにクラスの再定義や削除、同じ定義が別名で定義されたり(実際には名前を付け替えているつもり)が頻発する環境だと、ECLOSが探索するサブクラスのメンテナンスがなおざりになることが多いので、算出された結果も開発者の直感からすると古い情報に基いてしまったりすることがあるようです。
まあ、正しくクラスを削除、再定義すれば良いのでそういうユーティリティを充実させるのも良いかもしれません。

STklos系は、動的にメタクラスを生成するのと、クラス順位リストがサブクラスに比べてきっちり更新されるので、トラブルらしいトラブルには遭遇していません。

さて、どちらの方式が便利なのか……。 しばらく両方の方式を日々比較検討試していきたいと思います。


HTML generated by 3bmd in LispWorks 7.0.0

comments powered by Disqus