Posted 2020-12-14 15:00:00 GMT
allocate-instance Advent Calendar 2020 15日目の記事です。
Java等では、インスタンス化不可な抽象クラスを定義したり、抽象クラスでメソッドの実装を強制したりできますが、Common Lispだとmixinクラスのインスタンス化はマナーとしてしない程度です。さらに、メソッドの実装を強制については、そもそも総称関数なのでクラスが統治の単位でもありません。
また、オブジェクト指向システムがとても動的なので、チェックがコンパイル時ではなく、実行時によってしまうというのもいま一つなところです。
とはいえ、MOPのインスタンス生成プロトコルにフックを掛けてインスタンス化を抑止することは可能で、そのフックのポイントがallocate-instance
からclass-prototype
あたりになります。
allocate-instance
でメソッド実装の強制まあ、allocate-instance
にメソッド実装の強制という責務はないのですが、インスタンスが生成されるポイントなのでフックを掛けるのがこのあたりになってしまいます。
とりあえず:abstract-methods
オプションにメソッドを指定してクラスに該当するメソッドが実装されているかをチェックするのをallocate-instance :before
に仕掛けます。
(defpackage "0cbdbd51-5be8-57c3-9b14-9473f74c8a61" (:use c2cl))
(cl:in-package "0cbdbd51-5be8-57c3-9b14-9473f74c8a61")
(defclass enforcing-abstract-methods-class (standard-class)
((abstract-methods :initform '() :accessor class-abstract-methods)
(direct-abstract-methods :initform '()
:reader class-direct-abstract-methods
:initarg :abstract-methods)))
(defmethod finalize-inheritance :after ((class enforcing-abstract-methods-class))
(setf (class-abstract-methods class)
(remove-duplicates
(loop :for c :in (class-precedence-list class)
:when (typep c 'enforcing-abstract-methods-class)
:append (mapcar #'eval (class-direct-abstract-methods c)))
:from-end T)))
(defmethod allocate-instance :before ((class enforcing-abstract-methods-class)
&key &allow-other-keys)
(dolist (gf (class-abstract-methods class))
(or (some (lambda (x)
(find class (method-specializers x)))
(generic-function-methods gf))
(error "Can't instantiate abstract class ~S with abstract methods ~S."
class
gf))))
ついでに、インスタンス化不可なabstract-class
も定義します。
こちらは、以前ブログで紹介したものになります。
一応仕組みを解説すると、abstract-class
を:metaclass
に指定した場合、class-prototype :around
とallocate-instance
の組み合わせがエラーになりますが、抽象クラスのサブクラスがstandard-class
等を:metaclass
に指定すれば、通常ルートでインスタンス生成が実行されるのでエラーにならない、という流れです。
(defclass abstract-class (standard-class)
())
(defmethod validate-superclass ((class abstract-class) (superclass standard-class))
T)
(defmethod validate-superclass ((class standard-class) (superclass abstract-class))
T)
(defvar *outside-abstract-class* nil)
(defmethod allocate-instance ((class abstract-class) &key &allow-other-keys)
(unless *outside-abstract-class*
(error "There was an attempt to make an instance of abstract class ~S" (class-name class))))
(defmethod class-prototype :around ((class abstract-class))
(let ((*outside-abstract-class* T))
(call-next-method)))
;; 抽象クラス
(defclass foo ()
(a b c)
(:metaclass abstract-class))
;; インスタンス化できない
(make-instance 'foo)
!!! There was an attempt to make an instance of abstract class foo
;; 実装するメソッド
(defgeneric ztesch (x))
(defgeneric bazola (x y))
;; メソッド実装強制クラス
(defclass bar (foo)
()
(:metaclass enforcing-abstract-methods-class)
(:abstract-methods #'ztesch #'bazola))
;; インスタンス化できない
(make-instance 'bar)
!!! Can't instantiate abstract class #<enforcing-abstract-methods-class bar 41C00A64F3> with abstract methods #<common-lisp:standard-generic-function ztesch 41E001C3FC>.
;; 抽象クラス+メソッド実装強制メタクラス
(defclass abstract-class-enforcing-abstract-methods-class (abstract-class enforcing-abstract-methods-class)
())
;; 抽象クラス+メソッド実装強制クラス(が抽象クラスを継承)
(defclass baz (foo)
()
(:metaclass abstract-class-enforcing-abstract-methods-class)
(:abstract-methods #'ztesch #'bazola))
;; インスタンス化できない(なお実装を強制されたメソッドが空の場合、抽象クラス側のエラーとなる)
(make-instance 'baz)
!!! Can't instantiate abstract class #<abstract-class-enforcing-abstract-methods-class baz 42205DAC5B> with abstract methods #<common-lisp:standard-generic-function ztesch 424001B494>.
;; 抽象クラス+メソッド実装強制クラス(が抽象クラスを継承)のサブクラス
(defclass quux (baz)
()
(:metaclass enforcing-abstract-methods-class))
(finalize-inheritance (find-class 'quux))
;; 実装が強制されたメソッドの確認
(class-abstract-methods (find-class 'quux))
→ (#<common-lisp:standard-generic-function ztesch 41E001C3FC> #<common-lisp:standard-generic-function bazola 41E001C434>)
;; メソッドが実装されていないのでエラー
(make-instance 'quux)
!!! Can't instantiate abstract class #<enforcing-abstract-methods-class quux 40201AD06B> with abstract methods #<common-lisp:standard-generic-function ztesch 41E001C3FC>.
;; メソッドの実装
(defmethod ztesch ((q quux))
(with-slots (a b c) q
(setq a 0 b 1 c 2))
q)
(defmethod bazola ((x integer) (y quux))
(with-slots (a b c) y
(* x (+ a b c))))
;; インスタンス化できた
(bazola 10 (ztesch (make-instance 'quux)))
→ 30
今回は抽象クラスとメソッド実装の強制を別々に定義してメタクラスのmixinとしました。
メソッド実装が強制されるという感覚にいま一つ馴染がないのですが、Common Lispにどうなるのが正しいのかは色々コードを書いてみないと分からなさそうです……。
■
HTML generated by 3bmd in LispWorks 7.0.0