有没有办法访问 CLOS 中的超类插槽?
例如,在目标C中,我可以执行
- (void) frob {
[super frob]
}
这会向 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))
如何有一个方法,比如说,BEHAVIOR-TYPES
或GET-BEHAVIOR
,当用 horse
类型的对象调用时,返回 '(:eat :sleep :drink :buck :gambol :neigh)
。 也就是说,通过插槽的继承"添加"到初始化形式,而不是替换它。
一个简单的解决方案是,而不是将数据分配给类,使用如下所示的泛型方法:
(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
而不是它正确所属的类中。 所以这个问题的动机就由此而来。
无论如何 - 所提出的问题反映了对CLOS设计的误解。按照要求和正常框架,不可能执行此任务。但是,下面给出了两种单独的方法,使用 MOP 来解决我提出的问题。
你的问题的标题听起来像是在问如何访问插槽,但你显示的代码似乎更像是关于调用专门用于超类的方法。 如果你正在寻找后者,你应该看看 call-next-method
,以及 HyperSpec 中的 7.6 泛型函数和方法。
调用"超类方法"
在 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
使用方法组合进行模拟
可以使用方法组合来组合适用于参数列表的方法的结果。 例如,您可以定义一个方法组合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
使用 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))
我想得到以下内容:
(f(make-instance'sub)) -> "head tail"
我在 defclass 插槽描述中没有找到标准选项 这。我想为每个定义连接组合 元类"用户类"。
响应(由 Heiko Kirschke 提供,而不是我,但也看到 Jon White 以类似方法的响应)定义了一种新的类类型:
(defclass user-class (standard-class) ())
并专门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))
然后像这样使用:
(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 兼容层包可能会为您提供帮助。
CLOS 中没有超类的实例槽这样的概念。
如果创建实例,则该实例具有所有槽。类及其超类中的所有插槽。
如果一个类有一个插槽FOO
并且一些超类也有名为FOO
的插槽,则所有这些插槽都将合并到一个插槽中。该 CLOS 类的每个实例都将具有该槽。
你仍然需要更加小心你的措辞。超类本身就是对象,它们本身也有插槽。但这与具有本地槽的实例和具有实例槽的超类无关。后者在 CLOS 中不存在。
CL-USER 18 > (defclass bar () (a b))
#<STANDARD-CLASS BAR 413039BD0B>
上面是一个带有两个插槽的超类。
CL-USER 19 > (defclass foo (bar) (b c))
#<STANDARD-CLASS FOO 4130387C93>
上面是一个具有两个本地插槽和一个继承插槽的类。插槽b
实际上是从这个类和超类合并的。
CL-USER 20 > (describe (make-instance 'foo))
#<FOO 402000951B> is a FOO
B #<unbound slot>
C #<unbound slot>
A #<unbound slot>
上面显示该实例有三个插槽,都可以直接访问。甚至是在超类中定义的插槽'a。
如果我们将实际的超类视为实例本身,我们会看到它的插槽:
CL-USER 21 > (describe (find-class 'bar))
#<STANDARD-CLASS BAR 413039BD0B> is a STANDARD-CLASS
NAME BAR
DEFAULT-INITARGS NIL
DIRECT-DEFAULT-INITARGS NIL
DIRECT-SLOTS (#<STANDARD-DIRECT-SLOT-DEFINITION A 4020005A23> #<STANDARD-DIRECT-SLOT-DEFINITION B 4020005A93>)
DIRECT-SUBCLASSES (#<STANDARD-CLASS FOO 4130387C93>)
DIRECT-SUPERCLASSES (#<STANDARD-CLASS STANDARD-OBJECT 40F017732B>)
PRECEDENCE-LIST (#<STANDARD-CLASS BAR 413039BD0B> #<STANDARD-CLASS STANDARD-OBJECT 40F017732B> #<BUILT-IN-CLASS T 40F00394DB>)
PROTOTYPE NIL
DIRECT-METHODS NIL
WRAPPER #(1539 (A B) NIL #<STANDARD-CLASS BAR 413039BD0B> (#<STANDARD-EFFECTIVE-SLOT-DEFINITION A 4020005AFB> #<STANDARD-EFFECTIVE-SLOT-DEFINITION B 4020005B63>) 2)
LOCK #<MP::SHARING-LOCK "Lock for (STANDARD-CLASS BAR)" Unlocked 41303AD4E3>
DOCUMENTATION-SLOT NIL
PLIST (CLOS::COPYABLE-INSTANCE #<BAR 402000638B>)
POTENTIAL-INITARGS 0
MAKE-INSTANCE-FLAGS 509
OTHER-LOCK #<MP:LOCK "Lock for (OTHER STANDARD-CLASS BAR)" Unlocked 41303AD553>
REINITIALIZE-INITARGS 0
REDEFINE-INITARGS 0
DEPENDENTS NIL
这真的非常非常糟糕。我希望有人会介入并修复它,尽管它应该说明这个想法:
(defclass agent () ((behaviour :initform do-nothing :accessor behaviour-of)))
(defclass walk-agent (agent) ((behaviour :initform and-walk)))
(defclass talk-agent (walk-agent) ((behaviour :initform and-talk)))
(defmethod sb-mop:compute-effective-slot-definition
:after (class (name (eql 'behaviour)) sdlotds)
(setf *slot-def*
(loop
:for slot :in sdlotds :do
(format t "~&slot: ~s" (sb-mop:slot-definition-initform slot))
:collect (sb-mop:slot-definition-initform slot))))
(defmethod initialize-instance :before ((instance agent) &rest keyargs)
(declare (ignore keyargs))
(let (*slot-def*)
(declare (special *slot-def*))
(sb-mop:compute-slots (class-of instance))
(setf (behaviour-of instance) *slot-def*)))
;; (behaviour-of (make-instance 'talk-agent))
;; slot: AND-TALK
;; slot: AND-WALK
;; slot: DO-NOTHING
;; slot: AND-TALK
;; slot: AND-WALK
;; slot: DO-NOTHING
;; (AND-TALK AND-WALK DO-NOTHING)
附言。我看到在 SBCL 中计算插槽定义列表的函数在 std-class.lisp 中,std-compute-slots
.所以这不是 MOP 以某种方式定义的东西......但是这个在这里真的很有帮助。