【Common Lisp】defclassのスロットを型安全にする

注: Common Lisp処理系はSBCL 2.3.1を使用しています。
defclassの型注釈は型安全を保証しない
defclass
マクロでクラスを定義する際、スロットに対して下記のように型注釈を付けることができます。
(defclass person () ((name :type string :accessor person-name :initarg :name) (age :type integer :accessor person-age :initarg :age))) (defun make-person (&key name age) (make-instance 'person :name name :age age))
それではpersonクラスのインスタンスを作ってみましょう... おっと手が滑った
CL-USER> (make-person :name 20 :age "taro") #<PERSON {701189FBE3}> CL-USER> (person-name *) 20
型注釈と異なる型の値が格納されましたが、エラーは発生していません。何故こうなったかを調べてみたところ、
The :type slot option specifies that the contents of the slot will always be of the specified data type. It effectively declares the result type of the reader generic function when applied to an object of this class. The consequences of attempting to store in a slot a value that does not satisfy the type of the slot are undefined.
(出典: CLHS: Macro DEFCLASS - LispWorks)
との記述があり、異なる型を持つ値がスロットに格納された時の結果は未定義とのこと。そこで、この操作の結果としてエラーを発火させて型安全にする方法について調べてみました。
解決策その1:最適化オプションsafetyを利用する
SBCLの処理系依存の機能ですが、クラス定義やスロットアクセスを行う箇所で(declaim (optimize safety))
という最適化オプションを適用することで、値の格納時に型判定が走るようになります。多分これが一番簡単な方法です。
解決策その2:スロット格納時に型判定を行うメタクラスを導入する
次に示す方法はMOP(MetaObject Protocol)を利用する方法です。MOPはANSI Common Lisp の仕様には含まれませんが、様々な処理系に実装されているデファクトスタンダードの機能です。もちろん処理系依存の機能なので、実装ではそれらの差異を吸収したCloser to MOPというライブラリを利用します。
下記のように、valid-classというメタクラスと、スロット格納時に型判定を行うメソッドを実装します。
(ql:quickload :closer-mop) (defclass valid-class (c2mop:standard-class) ()) (defmethod c2mop:validate-superclass ((class valid-class) (superclass c2mop:standard-class)) t) (defmethod (setf c2mop:slot-value-using-class) :before (new-value (class valid-class) object slot) (let ((slot-type (c2mop:slot-definition-type slot))) (unless (typep new-value slot-type) (error 'type-error :datum new-value :expected-type slot-type))))
defclass
マクロ呼び出しで先ほど作成したvalid-class
をメタクラスとして指定することで、スロット格納時に型判定が走るクラスを定義することができます。
(defclass person () ((name :type string :accessor person-name :initarg :name) (age :type integer :accessor person-age :initarg :age)) (:metaclass valid-class))
それでは実際にvalid-classをメタクラスに持つpersonクラスのインスタンスを作ってみましょう。
CL-USER> (make-person :name 20 :age "taro") The value 20 is not of type STRING [Condition of type TYPE-ERROR] CL-USER> (make-person :name "taro" :age "20") The value "20" is not of type INTEGER [Condition of type TYPE-ERROR] CL-USER> (make-person :name "taro" :age 20) #<PERSON {7011D717F3}> CL-USER> (setf (person-age *) "20") The value "20" is not of type INTEGER [Condition of type TYPE-ERROR]
スロットの型判定が行われていますね👌