Пользовательские варианты слотов не применяют никакого сокращения к его аргументу

Question

Скажите, если я определяю метакласс, который улучшает стандартные слоты с слотом для проверки, когда я передаю :validator (clavier:valid-email "The email is invalid") в качестве опции вместо сохранения результата выражения, которое является funcallable, он хранит само выражение. Я пропустил шаг при расширении стандартных слотов? Как обеспечить, чтобы выражение оценивалось перед сохранением? Я использую SBCL 1.2.11 кстати. Вот код, о котором идет речь

(unless (find-package 'clavier) 
    (ql:quickload :clavier)) 
(unless (find-package 'c2mop) 
    (ql:quickload :c2mop)) 
(defpackage #:clos2web/validation 
    (:use #:cl) 
    (:import-from #:c2mop 
       #:standard-class 
       #:standard-direct-slot-definition 
       #:standard-effective-slot-definition 
       #:validate-superclass 
       #:direct-slot-definition-class 
       #:effective-slot-definition-class 
       #:compute-effective-slot-definition 
       #:slot-value-using-class)) 

(in-package #:clos2web/validation) 

(defun true (value) 
    "Always return true." 
    (declare (ignore value)) 
    t) 

(defclass validation-class (standard-class) 
() 
    (:documentation "Meta-class for objects whose slots know how to validate 
    their values.")) 

(defmethod validate-superclass 
    ((class validation-class) (super standard-class)) 
    t) 

(defmethod validate-superclass 
    ((class standard-class) (super validation-class)) 
    t) 

(defclass validation-slot (c2mop:standard-slot-definition) 
    ((validator :initarg :validator :accessor validator :initform #'true 
       :documentation "The function to determine if the value is 
    valid. It takes as a parameter the value."))) 

(defclass validation-direct-slot (validation-slot 
            standard-direct-slot-definition) 
()) 

(defclass validation-effective-slot (validation-slot 
            standard-effective-slot-definition) 
()) 

(defmethod direct-slot-definition-class ((class validation-class) &rest initargs) 
    (declare (ignore initargs)) 
    (find-class 'validation-direct-slot)) 

(defmethod effective-slot-definition-class ((class validation-class) &rest initargs) 
    (declare (ignore initargs)) 
    (find-class 'validation-effective-slot)) 

(defmethod compute-effective-slot-definition 
    ((class validation-class) slot-name direct-slot-definitions) 
    (let ((effective-slot-definition (call-next-method))) 
    (setf (validator effective-slot-definition) 
      (some #'validator direct-slot-definitions)) 
    effective-slot-definition)) 

(defmethod (setf slot-value-using-class) :before 
    (new (class validation-class) object (slot validation-effective-slot)) 
    (when (slot-boundp slot 'validator) 
    (multiple-value-bind (validp msg) 
     (funcall (validator slot) new) 
     (unless validp 
     (error msg))))) 

;; Example usage 

(defclass user() 
    ((name :initarg :name) 
    (email :initarg :email :validator (clavier:valid-email "The email is invalid") :accessor email)) 
    (:metaclass validation-class)) 

(let ((pepe (make-instance 'user :name "Pepe" :email "pepe@tumadre.com"))) 
    (setf (email pepe) "FU!")) ;; should throw 

код не удается при создании экземпляра в качестве (клавир: ДЕЙСТВИТЕЛЬНАЯ-ПОЧТА «Электронная почта является недействительной») не является funcallable.

(CLAVIER:VALID-EMAIL 
    "The email is invalid") fell through ETYPECASE expression. 
Wanted one of (FUNCTION SYMBOL). 
    [Condition of type SB-KERNEL:CASE-FAILURE] 

Answer 1

Как и вышеприведенный комментарий, defclass не оценивает аргументы (это макрос). Хотя обычный совет - избегать eval, я думаю, что eval в этом случае может быть именно тем, что вы хотите. Хотя обычно вы соединяете форму непосредственно в какое-то тело макроса, с defclass, я думаю, что ответ состоит в том, чтобы оценить форму в инициализации слота и сохранить оценку (если она еще не была обнулена).

Это, вероятно, произойдет в:

(defmethod initialize-instance :after ((obj validation-slot) 
             &key &allow-other-keys) 
    #| ... |#) 

При желании можно также хранить :validation-message и :validation-fn как два отдельных аргументов, то звоните:

(multiple-value-bind (validp msg) 
    (funcall (funcall (validator-fn slot) 
         (validator-message slot)) 
      new) 
    (unless validp 
    (error msg))) 

Другой альтернативой было бы хранить в себя оценку формы и передать это макрос:

(defvar *email-validator* (CLAVIER:VALID-EMAIL "The email is invalid")) 
(defun email-validator (val) 
    (funcall *email-validator* val)) 

Затем пройдите email-validator в defclass.

Дополнительная информация Возможно, вы подтверждаете, что ваши функции проверки достоверности сигнализируют тип условий slot-validation-error вместо условий error. Тогда ваше условие может содержать ссылки на недействительный валидатор, значение, слот и экземпляр. Это может дать вам гораздо лучший контроль, чем исходная ошибка. Вы также можете добавить некоторые перезагрузки (прервать, чтобы пропустить настройку слота, use-value для предоставления другого значения).

В зависимости от вашей настройки, может также иметь смысл для вашей функции проверки, чтобы сигнализировать об этом напрямую, вместо того, чтобы возвращать несколько значений, которые затем принуждаются к сигналам.