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方法。）我不想创建元类，因为我可能想拦截已经实例化的标准对象。

当然我尝试了它并且它没有用（因为你在DEFMETHOD中如何LABELS？）但是我想要一些更有经验的人来验证它是不可行的方式和/或提出合适的方式。

编辑：

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)
       )))

调用（my-test）一些对象槽和数据作为args导致：

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提供面向方面/上下文的扩展的库。

轻量级替代方法是使用特殊/动态变量来指示方法何时应该进行记录：

(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中的Issue GENERIC-FLET-POORLY-DESIGNED Writeup。有趣的是阅读讨论为什么人们认为词法方法不如词法范围的函数有用。

所以，如果没有这些，我真的不认为有一种方法可以创建词法范围的方法，虽然我没有使用Sceje链接到另一个答案的ContextL，所以它可能会提供你需要的东西。

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

2 个答案: