如何定义Common Lisp槽定义元对象以扩展自定义槽选项？

1. 定义自定义直接槽定义类 #

首先创建一个继承自c2mop:standard-direct-slot-definition的类，专门用来存储自定义槽选项的值：

(defclass my-direct-slot-definition (c2mop:standard-direct-slot-definition)
  ((my-new-option :initarg :my-new-option
                  :reader my-new-option)))

这里的:my-new-option槽会接收类定义中传入的自定义选项值，my-new-option读取器用于后续获取该值。

2. 定义自定义类元对象 #

接下来需要自定义类元对象，控制类处理槽定义的逻辑，确保它使用我们刚才定义的槽类：

(defclass my-standard-class (c2mop:standard-class) ())

(defmethod c2mop:compute-direct-slot-definitions ((class my-standard-class) slots)
  (mapcar (lambda (slot-spec)
            (destructuring-bind (slot-name &rest options) slot-spec
              (apply #'make-instance 'my-direct-slot-definition
                     :name slot-name
                     options)))
          slots))

这个方法会遍历类定义中的每个槽规格，用my-direct-slot-definition实例化槽对象，并把所有选项（包括自定义的:my-new-option）传递进去。

3. 使用自定义元对象定义目标类 #

定义test3类时，必须通过:metaclass指定使用我们的自定义元对象，这样槽定义才会被正确处理：

(defclass test3 ()
  ((world :my-new-option T))
  (:metaclass my-standard-class))

4. 实现获取选项值的函数 #

编写函数，传入类对象后提取自定义选项的值：

(defun my-new-option-value (class)
  ;; 这里假设类只有一个槽，若要支持多槽可扩展为接收槽名参数
  (let ((slot-def (first (c2mop:class-direct-slots class))))
    (when (typep slot-def 'my-direct-slot-definition)
      (my-new-option slot-def))))

测试验证 #

调用函数即可得到预期结果：

(my-new-option-value (find-class 'test3))
;; => T

如果需要支持多槽场景，可以修改函数为接收类和槽名两个参数：

(defun my-new-option-value (class slot-name)
  (let ((slot-def (find slot-name (c2mop:class-direct-slots class)
                        :key #'c2mop:slot-definition-name)))
    (when (and slot-def (typep slot-def 'my-direct-slot-definition))
      (my-new-option slot-def))))

;; 调用方式：
(my-new-option-value (find-class 'test3) 'world)
;; => T

内容的提问来源于stack exchange，提问作者leinad