如何在生成实例期间强制检查插槽的类型？
How to force slot's type to be checked during make-instance?
假设我有以下 class 声明：
(defclass foo-class ()
((bar :initarg :bar
:type list)))
当我创建此 class 的实例时，make-instance 不会检查传递的参数是否满足插槽类型。所以，我可以这样创建 "invalid" 个对象：
> (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 定义一个检查初始化参数的方法。
为您的 class 定义元 class 和 SET-SLOT-VALUE-USING-CLASS 上的方法。但是你需要确保你的实现确实提供并使用了 SET-SLOT-VALUE-USING-CLASS。这是一个通用函数，是 MOP 的一部分。有些实现提供了它，但有些只在请求时使用它（否则设置插槽可能会导致速度下降）。
后者这里是自建的SBCL版本，检查写槽类型：
首先是元class:
; 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)
现在我们检查该元的所有插槽写入class:
; 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))
我们的示例 class 使用该元class:
(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.
sanity-clause 库昨天刚刚为此合并了一个特性。
Sanity clause is a data validation/contract library. You might use it for configuration data, validating an api response, or documents from a datastore. In a dynamically typed langauge, it helps you define clearly defined areas of doubt and uncertainty. We should love our users, but we should never blindly trust their inputs.
To make use of it, you define schemas, which can be property lists with symbols for keys and instances of :class:sanity-clause.field:field
所以：
(defclass person ()
((favorite-dog :type symbol
:field-type :member
:members (:wedge :walter)
:initarg :favorite-dog
:required t)
(age :type (integer 0)
:initarg :age
:required t)
(potato :type string
:initarg :potato
:required t))
(:metaclass sanity-clause.metaclass:validated-metaclass))
;; bad dog:
(make-instance 'person :favorite-dog :nope)
; Evaluation aborted on Error converting value for field #<MEMBER-FIELD {1004BFA973}>:
Value "NOPE" couldn't be found in set (WEDGE WALTER)
;; bad age:
(make-instance 'person :age -1 :favorite-dog :walter)
; Evaluation aborted on Error validating value -1 in field #<INTEGER-FIELD {1004BFF103}>:
* Value -1 didn't satisfy condition "must be larger than 0"
;; missing potato:
(make-instance 'person :age 7 :favorite-dog :walter)
; Evaluation aborted on A value for field POTATO is required but none was provided..
;; all OK:
(make-instance 'person :age 1 :favorite-dog :walter :potato "patate")
#<PERSON {10060371E3}>
假设我有以下 class 声明：
(defclass foo-class ()
((bar :initarg :bar
:type list)))
当我创建此 class 的实例时，make-instance 不会检查传递的参数是否满足插槽类型。所以，我可以这样创建 "invalid" 个对象：
> (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 定义一个检查初始化参数的方法。
为您的 class 定义元 class 和 SET-SLOT-VALUE-USING-CLASS 上的方法。但是你需要确保你的实现确实提供并使用了 SET-SLOT-VALUE-USING-CLASS。这是一个通用函数，是 MOP 的一部分。有些实现提供了它，但有些只在请求时使用它（否则设置插槽可能会导致速度下降）。
后者这里是自建的SBCL版本，检查写槽类型：
首先是元class:
; 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)
现在我们检查该元的所有插槽写入class:
; 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))
我们的示例 class 使用该元class:
(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.
sanity-clause 库昨天刚刚为此合并了一个特性。
Sanity clause is a data validation/contract library. You might use it for configuration data, validating an api response, or documents from a datastore. In a dynamically typed langauge, it helps you define clearly defined areas of doubt and uncertainty. We should love our users, but we should never blindly trust their inputs.
To make use of it, you define schemas, which can be property lists with symbols for keys and instances of :class:
sanity-clause.field:field
所以：
(defclass person ()
((favorite-dog :type symbol
:field-type :member
:members (:wedge :walter)
:initarg :favorite-dog
:required t)
(age :type (integer 0)
:initarg :age
:required t)
(potato :type string
:initarg :potato
:required t))
(:metaclass sanity-clause.metaclass:validated-metaclass))
;; bad dog:
(make-instance 'person :favorite-dog :nope)
; Evaluation aborted on Error converting value for field #<MEMBER-FIELD {1004BFA973}>:
Value "NOPE" couldn't be found in set (WEDGE WALTER)
;; bad age:
(make-instance 'person :age -1 :favorite-dog :walter)
; Evaluation aborted on Error validating value -1 in field #<INTEGER-FIELD {1004BFF103}>:
* Value -1 didn't satisfy condition "must be larger than 0"
;; missing potato:
(make-instance 'person :age 7 :favorite-dog :walter)
; Evaluation aborted on A value for field POTATO is required but none was provided..
;; all OK:
(make-instance 'person :age 1 :favorite-dog :walter :potato "patate")
#<PERSON {10060371E3}>