lisp:如何在作用域中创建临时方法专门化

Question

在Common lisp: Redefine an existing function within a scope?中，OP要求类似的东西。但我想创建一个方法特殊化程序，而不是一个函数。本质上假设一个方法是这样定义的：

defmethod my-meth ((objA classA) (objB classB)) (...)

我想做的是(伪代码)：

(labels ((my-meth ((objA classA) (objB (eql some-object)))))
   do stuff calling my-meth with the object...)

真正的用途是我想创建一个临时环境，在那里setf slot-value-using-class将专门处理eql，本质上是创建特定对象对其槽写入的按需拦截。(其目的是在某个地方记录新旧插槽的值，然后调用next方法。)我不想创建一个元类，因为我可能想截获已经实例化的标准对象。

当然，我试过了，但它不起作用(因为如何在LABELS中使用DEFMETHOD？)但我希望一些更有经验的人以这种方式验证它是不可行的，并/或提出一种合适的方式。

评论？

编辑：

Daniel和Terje提供了极好的链接来扩展我对各种可能性的认识，但我想在去那里之前，在寻找一种更普通的方法方面更进一步。我一直在寻找在进入环境时做一个add-method，它将专门用于eql，并在退出时执行一个remove-method。我还没有完成。如果有人玩过这些，评论会很好。会让线程保持最新。

编辑2:我即将使用add-method场景来做这件事，但是有一个问题。以下是我尝试过的方法：

    (defun inject-slot-write-interceptor (object fun)
    (let* ((gf (fdefinition '(setf sb-mop:slot-value-using-class)))
            (mc (sb-mop:generic-function-method-class gf))
            (mc-instance (make-instance (class-name mc) 
                            :qualifiers '(:after)
                            :specializers (list (find-class 't)
                                                (find-class 'SB-PCL::STD-CLASS)
                                                (sb-mop::intern-eql-specializer object) 
                                                (find-class 'SB-MOP:STANDARD-EFFECTIVE-SLOT-DEFINITION))
                           :lambda-list '(new-value class object slot)
                           :function (compile nil (lambda (new-value class object slot) (funcall fun new-value class object slot))))))
         (add-method gf mc-instance)
         (defun remove-slot-write-interceptor ()
            (remove-method gf mc-instance))
       ))

(defun my-test (object slot-name data)
     (let ((test-data "No results yet") 
           (gf (fdefinition '(setf sb-mop::slot-value-using-class))))
       (labels ((show-applicable-methods () (format t "~%Applicable methods: ~a" (length (sb-mop:compute-applicable-methods gf (list data (class-of object) object (slot-def-from-name (class-of object) slot-name)))))))
            (format t "~%Starting test: ~a" test-data)
            (show-applicable-methods)
            (format t "~%Injecting interceptor.")
            (inject-slot-write-interceptor object (compile nil (lambda (a b c d) (setf test-data "SUCCESS !!!!!!!"))))
            (show-applicable-methods)
            (format t "~%About to write slot.")
            (setf (slot-value object slot-name) data)
            (format t "~%Wrote slot: ~a" test-data)
            (remove-slot-write-interceptor)
            (format t "~%Removed interceptor.")
            (show-applicable-methods)
       )))      

使用某些对象槽和数据作为args调用(my-test)会导致：

Starting test: No results yet 
Applicable methods: 1 
Injecting interceptor. 
Applicable methods: 2 
About to write slot.     
Wrote slot: No results yet  <----- Expecting SUCCESS here....
Removed interceptor. 
Applicable methods: 1

所以我被困在这里了。特殊化是有效的，因为适用的方法现在包括eql-specialized :after方法，但不幸的是它似乎没有被调用。有没有人可以帮我，这样我就可以完成它，并将它重构为一个可爱的小工具宏？

Answer 1

否，您不能在Common Lisp.中定义动态范围或词法范围的专用方法

Aspect Oriented Programming可以用作解决底层问题的一种方法。另请参见Context-Oriented Programming。

ContextL是一个为Common Lisp / CLOS提供方面/上下文-oriented扩展的库。

一种轻量级的替代方法是使用特殊的/动态变量来指示方法何时应该执行日志记录：

(defparameter *logging* NIL "Bind to a true value to activate logging")

(defmethod my-meth :around ((objA classA) (objB (eql some-object)))
  (prog2 
   (when *logging*
     (logging "Enter my-meth"))
   (call-next-method)
   (when *logging*
     (logging "Exit my-meth"))))

(let ((*logging* T))
   (do stuff calling my-meth with the object...))

但请注意，当日志记录被禁用时，还将调用:around方法。

Answer 2

似乎曾经有为Common Lisp提出的generic-flet和generic-labels特殊形式，但它被从最终规范中删除了，因为它被认为很少被实现支持，并且设计得很差。请参见HyperSpec中的。阅读讨论为什么人们认为词法方法不如词法作用域函数有用，这是很有趣的。

所以，如果没有这些，我真的不认为有一种方法可以创建词法作用域的方法，尽管我还没有尝试过Terje在另一个答案中链接到的ContextL，所以它可能会提供你需要的东西。