如何在make-instance期间强制检查插槽的类型？

Question

假设我有以下类声明:

(defclass foo-class ()
  ((bar :initarg :bar
        :type list)))

当我创建这个类的实例时,make-instance不会检查传递的参数是否满足槽的类型.所以,我可以这样创建"无效"对象:

> (make-instance 'foo-class :bar 'some-symb)
#<FOO-CLASS {102BEC5E83}>

但是,我想看到的是类似于创建结构实例的行为,其中检查了类型:

(defstruct foo-struct
  (bar nil :type list))

> (make-foo-struct :bar 'some-symb)
;; raises contition:
;;
;; The value
;; SOME-SYMB
;; is not of type
;; LIST
;; when setting slot BAR of structure FOO-STRUCT

有没有办法实现这个目标？

Answer 1

是否正在检查槽类型是否未定义结构和CLOS实例.

许多实现将为结构做到 - 但不是全部.

很少有实现可以用于CLOS实例 - 例如Clozure CL实际上就是这样做的.

SBCL还可以检查CLOS插槽类型 - 当安全性很高时:

* (declaim (optimize safety))

NIL
* (progn
(defclass foo-class ()
  ((bar :initarg :bar
        :type list)))
(make-instance 'foo-class :bar 'some-symb))

debugger invoked on a TYPE-ERROR: The value SOME-SYMB is not of type LIST.

Type HELP for debugger help, or (SB-EXT:EXIT) to exit from SBCL.

restarts (invokable by number or by possibly-abbreviated name):
  0: [ABORT] Exit debugger, returning to top level.

((SB-PCL::SLOT-TYPECHECK LIST) SOME-SYMB)
0] 

怎么办呢？

这是一个高级主题,可能需要一些CLOS元对象协议hackery.两种变体:

• 为SHARED-INITALIZE定义一个检查init参数的方法.

• 为您的类定义元类,并在SET-SLOT-VALUE-USING-CLASS上定义方法.但是,您需要确保您的实现实际上提供了AND使用SET-SLOT-VALUE-USING-CLASS.这是一个通用函数,它是MOP的一部分.一些实现提供它,但是一些实现仅在请求时使用它(否则设置槽可能会得到速度惩罚).

对于后者,这里是自建的SBCL版本来检查写槽的类型:

首先是元类:

; first a metaclass for classes which checks slot writes
(defclass checked-class (standard-class)
  ())

; this is a MOP method, probably use CLOSER-MOP for a portable version
(defmethod sb-mop:validate-superclass
           ((class checked-class)
            (superclass standard-class))
   t)

现在我们检查该元类的所有插槽写入:

; this is a MOP method, probably use CLOSER-MOP for a portable version    
(defmethod (setf sb-mop:slot-value-using-class) :before
              (new-value (class checked-class) object slot)
  (assert (typep new-value (sb-mop:slot-definition-type slot))
      ()
    "new value ~a is not of type ~a in object ~a slot ~a"
    new-value (sb-mop:slot-definition-type slot) object slot))

我们的示例类使用该元类:

(defclass foo-class ()
  ((bar :initarg :bar :type list))
  (:metaclass checked-class))

使用它:

* (make-instance 'foo-class :bar 42)

debugger invoked on a SIMPLE-ERROR in thread
#<THREAD "main thread" RUNNING {10005605B3}>:
  new value 42 is not of type LIST
  in object #<FOO-CLASS {1004883143}>
  slot #<STANDARD-EFFECTIVE-SLOT-DEFINITION COMMON-LISP-USER::BAR>

Type HELP for debugger help, or (SB-EXT:EXIT) to exit from SBCL.

restarts (invokable by number or by possibly-abbreviated name):
  0: [CONTINUE] Retry assertion.
  1: [ABORT   ] Exit debugger, returning to top level.