6

在Common lisp 中：重新定义范围内的现有函数？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)
       )))

使用某些对象槽和数据作为 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 方法，但不幸的是它似乎没有被调用。任何人都可以帮助我完成它并将其重构为一个可爱的小实用宏吗？

4

2 回答 2

5

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

面向方面的编程可以用作解决潜在问题的方法。另请参阅面向上下文的编程。

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 方法。

于 2011-04-27T15:27:54.860 回答
3

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

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

于 2011-04-27T15:39:39.597 回答