Inheritance CLOS：如何调用不太具体的方法？

有一种通用方法，比如

incx

。有两个版本的

incx

。一个专用于类型

a

，一个专用于类型

b

。类型

b

是

a

的子类。您得到了一个类型为

b

的对象，即派生类型，但您希望调用类型为

a

的专用方法。如果在

b

类型上还没有专门的同名方法，那么您可以很容易地做到这一点，但是，唉，有这样一种方法

那么，在这种情况下，如何调用类型

a

的专用方法呢

(defclass a () ((x :accessor x :initform 0)))
(defclass b (a) ((y :accessor y :initform 0)))

(defgeneric inc (i))

(defmethod inc ((i a)) (incf (x i)))
(defmethod inc ((i b)) (incf (y i)))

(defvar r (make-instance 'b))

正如CLOS承诺的那样，这将调用最专门的方法：

* (inc r) 
* (describe r)
    ..
  Slots with :INSTANCE allocation:
    X  = 0
    Y  = 1

但在这种特殊情况下，（不是一般情况下），我想要的是访问不太专业的版本。比如说：

(inc (r a)) ; crashes and burns of course, no function r or variable a
(inc a::r)  ; of course there is no such scoping operator in CL

我看到

调用下一个方法

函数可以在一个专门化方法中使用，以获得下一个不太专门化的方法，但这不是这里想要的

在这段代码中，我确实需要类似于

调用下一个方法

，但用于调用补充方法。我们不需要在下一个不太专业化的类中调用同名的方法，而是需要调用其具有不同名称的互补方法。补充方法也是专门化的，但是调用这个专门化的版本不起作用-原因与

调用下一个方法

可能包含的原因大致相同。在超类上专门化的所需方法的名称并不总是相同的

(call-next-method my-complement)  ; doesn't work, thinks my-complement is an arg

这里是另一个例子

有一个描述电子特性的基类和一个描述“奇怪电子”特性的派生类。专门研究奇异电子的方法希望调用专门研究电子的方法。为什么？因为这些方法为程序做了正常电子部分的工作。奇怪电子的非电子部分几乎是微不足道的，或者更确切地说，如果它没有复制电子代码：

(defgeneric apply-velocity (particle velocity))
(defgeneric flip-spin (particle))

;;;; SIMPLE ELECTRONS

(defclass electron ()
  ((mass
      :initform 9.11e-31
      :accessor mass)
   (spin
      :initform -1
      :accessor spin)))

(defmacro sq (x) `(* ,x ,x))

(defmethod apply-velocity ((particle electron) v)
  ;; stands in for a long formula/program we don't want to type again:
  (setf (mass particle) 
        (* (mass particle) (sqrt (- 1 (sq (/ v 3e8)))))))

(defmethod flip-spin ((particle electron))
  (setf (spin particle) (- (spin particle))))

;;;; STRANGE ELECTRONS

(defclass strange-electron (electron)
  ((hidden-state
      :initform 1
      :accessor hidden-state)))

(defmethod flip-spin ((particle strange-electron))
  (cond
    ((= (hidden-state particle) 1)
     (call-next-method)

     ;; CALL ELECTRON'S APPLY-VELOCITY HERE to update
     ;; the electron. But how???
     )
    (t nil)))

;; changing the velocity of strange electrons has linear affect!
;; it also flips the spin without reguard to the hidden state!
(defmethod apply-velocity ((particle strange-electron) v)
  (setf (mass particle) (* (/ 8 10) (mass particle)))

  ;; CALL ELECTRON'S SPIN FLIP HERE - must be good performance,
  ;; as this occurs in critical loop code, i.e compiler needs to remove
  ;; fluff, not search inheritance lists at run time
  )

这一切归结为一个简单的问题：

---

如果定义了更专业的方法，如何调用不太专业的方法？

可以使用MOP（MetaObect协议）。似乎这正是你想要的

使用

change class

也可能玩一些非常可怕的把戏

---

请注意，CLO中的方法不是“类上的方法”，而是“泛型函数上的方法”。因此，您不能真正调用“父类中具有不同名称的方法”，只能调用不同的泛型函数。

您的问题包含两个问题：

如何调用特定的有效方法

在电子模拟的情况下，如何避免复制粘贴

这个答案是我的另一个答案的合并，部分灵感来自于这个具体的例子。我将首先讨论所问的问题（调用特定方法），并解释为什么您应该尝试另一种方法，尤其是针对您的示例

调用有效的方法 是的，您可以调用与方法关联的函数，而不是泛型函数。 对于便携式进近，首先加载更近的拖把：

定义一些类和一个简单的泛型函数：

(defclass a () ())
(defclass b (a) ())
(defclass c (b) ())
(defgeneric foo (x)
  (:method ((x a)) 0)
  (:method ((x b)) (+ (call-next-method) 1))
  (:method ((x c)) (* (call-next-method) 2)))

我们有一个类层次结构（a 现在，我们计算类b的适用方法，并使用结果列表定义一个函数，该函数调用b上专门化的

foo

有效方法

(destructuring-bind (method . next)
    (closer-mop:compute-applicable-methods-using-classes
     #'foo
     (list (find-class 'b)))
  (let ((fn (closer-mop:method-function method)))
    (defun %foo-as-b (&rest args)
      (funcall fn args next))))

这里有两种不同的行为：

(let ((object (make-instance 'c)))
  (list
    (%foo-as-b object)
    (foo object))

=> (1 2)

但是，不建议这样做。 CLOS提供了一种结合有效方法的方法，您应该按照预期使用它，而不是劫持它。 事实上，假设我评估以下内容：

(defmethod foo :before ((i a)) (print "Before A"))

对c的实例c调用的

foo

通用函数将打印字符串。但是，当在c上使用

%foo-as-b

时，不会打印任何字符串，即使我们调用函数时将c当作b的实例，并且该方法专门用于a

(destructuring-bind (method . next)
    (closer-mop:compute-applicable-methods-using-classes
     #'foo
     (list (find-class 'b)))
  (let ((fn (closer-mop:method-function method)))
    (defun %foo-as-b (&rest args)
      (funcall fn args next))))

这当然是因为

使用类计算适用的方法取决于调用时已知的方法集。在这种情况下，函数
%foo-as-b
仍在使用过时的方法列表。如果您定义了多个这样的函数或对多个类进行专门化，则效果会更大。如果您希望始终保持
%foo-as-b
与您的环境同步，那么您需要在每次调用此函数时重新计算列表（而不是在lambda中重新计算值，而不是让lambda通过）。
另一种可能是在CLO中引入钩子，以便在需要时重新计算函数，但这太疯狂了

不要过度使用继承来共享代码
考虑一下这个问题。
springs的建议是，过度使用继承来共享代码（即实现细节）而不是多态性，这就是“偏爱组合而不是继承”。
看见
和
有关这方面的更多详细信息

使用函数
在C++中，在这里找到代码>：：方法（）/<代码>，您只需要调用一个具有类似名称的不同函数：当您告诉编译器要调用的方法时，没有动态调度，所以实际上这就像调用一个常规函数。
根据你的要求，我将写以下内容。它基于Dirk的版本，并使用了辅助内联局部函数，当您希望避免重复时，这些函数非常合适：

(defclass electron ()
  ((mass :initform 9.11e-31 :accessor mass)
   (spin :initform -1 :accessor spin)))

(defclass strange-electron (electron)
  ((hidden-state :initform 1 :accessor hidden-state)))

(let ((light-speed 3e8)
      (mysterious-velocity 0d0))
  (flet ((%flip (p)
           (setf (spin p) (- (spin p))))
         (%velocity (p v)
           (setf (mass p)
                 (* (mass p)
                    (sqrt
                     (- 1 (expt (/ v light-speed) 2)))))))
    (declare (inline %flip %velocity))
    
    (defgeneric flip-spin (particle)
      (:method ((p electron))
        (%flip p))
      (:method ((p strange-electron))
        (when (= (hidden-state p) 1)
          (call-next-method)
          (%velocity p mysterious-velocity))))

    (defgeneric apply-velocity (particle velocity)
      (:method ((p electron) v)
        (%velocity p v))
      (:method ((p strange-electron) v)
        (setf (mass p)
              (* (/ 8 10) (mass p)))
        (%flip p)))))

这个问题已经解决了，并且很有希望是可读的：没有必要在CLOS中破解其他东西。由不同方法共享的辅助函数很容易识别，如果需要重新编译其中任何一个，则必须重新编译整个表单
;; Common base class
(defclass electron () ())

;; Actual data for mass and spin
(defclass simple-electron (electron)
  ((mass :initform 9.11e-31 :accessor mass)
   (spin :initform -1 :accessor spin)))

;; A strange electron with a hidden state
(defclass strange-electron (electron)
  ((simple-electron :accessor simple-electron :initarg :electron)
   (hidden-state :initform 1 :accessor hidden-state)))

(macrolet ((delegate (fn &rest args)
             `(defmethod ,fn (,@args (e strange-electron))
                (funcall #',fn ,@args (simple-electron e)))))
  (delegate mass)
  (delegate spin)
  (delegate (setf mass) new-value)
  (delegate (setf spin) new-value))

(defmethod (setf spin) (new-value (e strange-electron))
  (funcall #'(setf spin) new-value (simple-electron e)))

(defmethod flip-spin ((e simple-electron))
  (setf (spin e) (- (spin e))))

(defmethod apply-velocity ((e simple-electron) velocity)
  (setf (mass e)
        (* (mass e)
           (sqrt
            (- 1 (expt (/ velocity +light-speed+) 2))))))

(defmethod flip-spin ((e strange-electron))
  (when (= (hidden-state e) 1)
    (flip-spin (simple-electron e))
    (apply-velocity (simple-electron e) 0d0)))

(defmethod apply-velocity ((e strange-electron) velocity)
  (setf (mass e) (* (/ 8 10) (mass e)))
  (flip-spin (simple-electron e)))

(defun actually-inc-a (value) (incf (x value)))
(defun actually-inc-b (value) (incf (y value)))

(defmethod inc ((object a)) (actually-inc-a object))
(defmethod inc ((object b)) (actually-inc-b object))

(defun apply-velocity-for-simple-electron (particle v)
  (setf (mass particle) (* (mass particle) (sqrt (- 1 (sq (/ v 3e8)))))))

(defun flip-spin-for-simple-electron (particle)
  (setf (spin particle) (- (spin particle))))

(defmethod apply-velocity ((particle electron) v)
  (apply-velocity-for-simple-electron particle v))

(defmethod flip-spin ((particle electron))
  (flip-spin-for-simple-electron particle))

(defmethod apply-velocity ((particle strange-electron) v)
  (setf (mass particle) (* (/ 8 10) (mass particle)))
  (flip-spin-for-simple-electron particle))

(defmethod flip-spin ((particle strange-electron))
  (when (= (hidden-state particle) 1)
    (call-next-method)
    (apply-velocity-for-simple-electron particle #| Hu? What's the V here? |#)))

(defvar *strange-electron-bypass* nil)

(defmethod flip-spin ((particle strange-electron))
  (let ((bypass *strange-electron-bypass*)
        (*strange-electron-bypass* nil))
    (cond (bypass
           (call-next-method))
          ((= (hidden-state particle) 1)
           (call-next-method)
           (let ((*strange-electron-bypass* t))
             ;; where does v come from?
             (apply-velocity particle v)))
          (t
           nil))))

(defmethod apply-velocity ((particle strange-electron) v)
  (let ((bypass *strange-electron-bypass*)
        (*strange-electron-bypass* nil))
    (cond (bypass
           (call-next-method))
          (t
           (setf (mass particle)
                 (* (/ 8 10) (mass particle)))
           (let ((*strange-electron-bypass* t))
             (flip-spin particle))))))

(defclass a () ((x :accessor x :initform 0)))
(defclass b (a) ((y :accessor y :initform 0)))

(defgeneric inc (i))
(defgeneric inc-a (i)) ; same as inc, but won't be further specialized

(defmacro inc-a-stuff (i) ; this is not exported! not an interface
  `(incf (x ,i))
  )

(defmethod inc ((i a)) (inc-a-stuff i))
(defmethod inc ((i b)) (incf (y i)))

;; provides a method to generalize back to class a
;; this method does not get further specialization by b, thus
;; remains a window into the "a part"
(defmethod inc-a ((i a)) (inc-a-stuff i))

(defvar r (make-instance 'b))

(inc r) ; all good, increments y

;;(inc (r a)) ; ah how do you get this?
;;
(inc-a r) ; 

(describe r)

#|
Slots with :INSTANCE allocation:
  X  = 1
  Y  = 1
|#