有没有办法访问CLOS中超类列表中的插槽?

Pau*_*han 2 common-lisp clos mop

有没有办法在CLOS中访问超类的插槽?

例如,在目标CI中可以执行

- (void) frob {
[super frob]
}
Run Code Online (Sandbox Code Playgroud)

这会向frob的(唯一)超类发送消息.

仔细阅读CLOS文档表明,DEFCLASS合并了有关类创建的所有超类信息,因此这种与超类通信的能力将丢失.它是否正确?

编辑:

这种情况有点不寻常:

鉴于课程

(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))
Run Code Online (Sandbox Code Playgroud)

当使用类型的对象调用时,如何使用方法,BEHAVIOR-TYPES或者GET-BEHAVIORhorse返回'(: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)))
Run Code Online (Sandbox Code Playgroud)

但是,此解决方案将数据移动到defgeneric正确属于的类而不是类.所以问题的动机就是出于这个问题.

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

Jos*_*lor 5

你的问题的标题听起来好像你在询问如何访问插槽,但你展示的代码似乎更像是调用专门用于超类的方法.如果是后者,你要寻找的,你应该看一看call-next-method,以及7.6泛型函数和方法从HyperSpec.

调用"超类方法"

在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
Run Code Online (Sandbox Code Playgroud)

用方法组合模拟它

您可以使用方法组合来组合适用于参数列表的方法的结果.例如,您可以a使用方法组合定义方法,list这意味着在调用时(a thing),将调用适用于参数的所有方法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
Run Code Online (Sandbox Code Playgroud)

使用MOP

1998年关于Allegro CL档案的这篇文章值得一读.这听起来像作者正在寻找类似于你正在寻找的东西.

我需要定义一个继承行为,它将超类初始化的字符串值与本地插槽初始化连接起来.例如

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

(defclass sub(super)
  ((f :accessor f :initform "tail")) (:metaclass user-class))
Run Code Online (Sandbox Code Playgroud)

我想得到以下内容:

(f(make-instance'sub)) -> "head tail"
Run Code Online (Sandbox Code Playgroud)

我没有在defclass插槽描述中找到标准选项.我想为每个元类"用户类"定义连接组合.

答案(由Heiko Kirschke,不是我,但也看到Jon White用类似方法做出的回应),定义了一种新类型:

(defclass user-class (standard-class) ())
Run Code Online (Sandbox Code Playgroud)

并专门clos:compute-effective-slot-definition提供一个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))
Run Code Online (Sandbox Code Playgroud)

然后就像这样使用:

(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"
Run Code Online (Sandbox Code Playgroud)

这是进入规范未指定的MOP功能,因此您可能必须根据您的特定实现进行调整.但是,有一些MOP兼容层包可能会帮助你.