common-lisp - 有没有办法访问 CLOS 父类(super class)列表中的插槽？

Question

有没有办法在 CLOS 中访问父类(super class)的插槽？

例如，在 Objective C 中我可以执行

- (void) frob {
[super frob]
}

这会向 frob 的(唯一)父类(super class)发送一条消息。

仔细阅读 CLOS 文档表明 DEFCLASS 合并了关于类创建的所有父类(super class)信息，因此与父类(super class)通信的能力丢失了。它是否正确？

编辑:

这个场景有点不寻常:

给定的类

(defclass animal ()
  ((behavior-types
     :initform '(:eat :sleep :drink)
     :reader behavior-types)))

(defclass cow (animal)  
  ((behavior-types
     :initform '(:moo :make-milk)
     :reader behavior-types))

(defclass horse
  ((behavior-types 
     :initform '(:buck :gambol :neigh)
     :reader behavior-types))

如何拥有一个方法，例如，BEHAVIOR-TYPES 或 GET-BEHAVIOR，当用 horse 类型的对象调用时，返回 '(:eat :sleep :drink :buck :gambol :neigh)。也就是说，通过插槽继承“添加”到 initform 而不是替换它。

一个简单的解决方案不是将数据分配给类，而是使用如下的通用方法:

(defgeneric behavior-types (obj))

(defmethod behavior-types ((obj animal)) nil)

(defmethod behavior-types :around ((obj animal))
  (append '(:eat :sleep :drink)
          (call-next-method obj)))


(defmethod behavior-types :around ((obj horse))
  (append '(:gambol :neigh :buck)
          (call-next-method obj)))

但是，此解决方案将数据移动到 defgeneric 而不是类，它应该属于该类。于是就有了这个问题的动机。

无论如何 - 提出的问题反射(reflect)了对 CLOS 设计的误解。按照要求并在正常 框架内执行此任务是不可能的。但是，下面给出了两种使用 MOP 来解决我提出的问题的不同方法。

Answer 1

你的问题的标题听起来像是在询问如何访问插槽，但你显示的代码似乎更像是关于调用专用于父类(super class)的方法。如果你正在寻找后者，你应该看看 call-next-method ，以及 7.6 Generic Functions and Methods来自 HyperSpec。

调用“父类(super class)方法”

在 CLOS 中，方法不像在某些其他语言中那样属于类。相反，有一些通用函数，在这些函数上定义了专门的方法。对于给定的参数列表，许多方法可能适用，但只有一种是最具体。您可以使用 call-next-method 调用下一个最具体的方法。在下面的文字记录中，有一个类 FOO 和一个子类 BAR，以及一个通用函数 FROB，它具有专门用于 FOO< 的方法 和 BAR。在专用于 BAR 的方法中，有一个对 call-next-method 的调用，在本例中，它调用专用于 FOO 的方法。

CL-USER> (defclass foo () ())
;=> #<STANDARD-CLASS FOO>
CL-USER> (defclass bar (foo) ())
;=> #<STANDARD-CLASS BAR>
CL-USER> (defgeneric frob (thing))
;=> #<STANDARD-GENERIC-FUNCTION FROB (0)>
CL-USER> (defmethod frob ((foo foo))
           (print 'frobbing-a-foo))
;=> #<STANDARD-METHOD FROB (FOO) {1002DA1E11}>
CL-USER> (defmethod frob ((bar bar))
           (call-next-method)
           (print 'frobbing-a-bar))
;=> #<STANDARD-METHOD FROB (BAR) {1002AA9C91}>
CL-USER> (frob (make-instance 'bar))

FROBBING-A-FOO 
FROBBING-A-BAR 
;=> FROBBING-A-BAR

用方法组合模拟它

您可以使用方法组合来组合适用于参数列表的方法的结果。例如，您可以使用方法组合 list 定义一个方法 a，这意味着当您调用 (a thing) 时，all 调用适用于参数的 a 上的方法，并将它们的结果合并到一个列表中。如果您为不同类中的插槽指定不同的名称，并在 a 上指定读取这些值的方法，您就可以模拟您正在寻找的那种东西。这并不妨碍您也使用访问插槽的传统阅读器(例如，以下示例中的 get-a)。以下代码显示了一个示例:

(defgeneric a (thing)
  (:method-combination list))

(defclass animal ()
  ((animal-a :initform 'a :reader get-a)))

(defmethod a list ((thing animal))
  (slot-value thing 'animal-a))

(defclass dog (animal)
  ((dog-a :initform 'b :reader get-a)))

(defmethod a list ((thing dog))
  (slot-value thing 'dog-a))

(a (make-instance 'dog))

(get-a (make-instance 'animal))
;=> A

(get-a (make-instance 'dog))
;=> B

使用 MOP

This post从 1998 年开始的关于 Allegro CL 的文件值得一读。听起来作者正在寻找与您正在寻找的东西相似的东西。

I need to define an inheritance behavior that concatenates string-values of superclass-initforms with local slot initforms. E.g.

(defclass super()
  ((f :accessor f :initform "head")) (:metaclass user-class))

(defclass sub(super)
  ((f :accessor f :initform "tail")) (:metaclass user-class))

I'd like to get the following:

(f(make-instance'sub)) -> "head tail"

I didn't find a standard option in defclass slot-descriptions for this. I'd like to define the concatenate combination for each meta-class 'user-class'.

响应(来自 Heiko Kirschke，不是我，但也以类似的方法参见 this response from Jon White)，定义了一种新的类:

(defclass user-class (standard-class) ())

并特化了clos:compute-effective-slot-definition 以提供根据类及其父类(super class)的槽定义计算的 initform:

(defmethod clos:compute-effective-slot-definition
    ((the-class user-class) slot-name
     ;; The order of the direct slots in direct-slot-definitions may
     ;; be reversed in other LISPs (this is code written & tested with
     ;; ACL 4.3):
     direct-slot-definitions)
  (let ((slot-definition (call-next-method))
    (new-initform nil))
    (loop for slot in direct-slot-definitions
    as initform = (clos:slot-definition-initform slot)
    when (stringp initform)
    do
      ;; Collecting the result string could be done perhaps more
      ;; elegant:
      (setf new-initform (if new-initform
                 (concatenate 'string initform " "
                          new-initform)
                   initform)))
    (when new-initform
      ;; Since at (call-next-method) both the initform and
      ;; initfunction of the effective-slot had been set, both must be
      ;; changed here, too:
      (setf (slot-value slot-definition 'clos::initform) new-initform)
      (setf (slot-value slot-definition 'clos::initfunction)
    (constantly new-initform)))
    slot-definition))

然后是这样使用的:

(defclass super ()
  ((f :accessor f :initform "head"))
  (:metaclass user-class))

(defclass sub(super)
  ((f :accessor f :initform "tail"))
  (:metaclass user-class))

(f (make-instance 'sub))
==> "head tail"

这是进入规范未指定的 MOP 功能，因此您可能需要针对您的特定实现调整它。不过，有一些 MOP 兼容层包可能可以帮助您。