如何在创建实例期间强制检查插槽的类型？

假设我有以下类声明：

(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

有什么办法可以实现这一点吗？

对于结构和 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 元对象协议黑客技术。两种变体：

• 为 SHARED-INITALIZE 定义一个方法来检查初始化参数。

• 为您的类定义一个元类，并在 SET-SLOT-VALUE-USING-CLASS 上定义一个方法。但是您需要确保您的实现实际上提供并使用 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.