In Common lisp: Redefine an existing function within a scope? the OP asked for something similar. But I want to create a method specializer, not a function. Essentially suppose that a method is defined such:
defmethod my-meth ((objA classA) (objB classB)) (...)
What I would like to do is (pseudocode):
(labels ((my-meth ((objA classA) (objB (eql some-object)))))
do stuff calling my-meth with the object...)
The real use is that I want to create a temporary environment, where setf slot-value-using-class will be specialized on eql, essentialy creating a specific object's on-demand interception of its slot writing. (The purpose is to log somewhere the old and new slot values and then call next method.) I don't want to create a metaclass because I may want to intercept already instantiated standard objects.
Of course I tried it and it didn't work (because how do you DEFMETHOD in a LABELS?) but I wanted some more experienced people to verify that it is not doable in such a way and/or propose a suitable way.
Comments?
EDIT:
Daniel and Terje provide excellent links for widening my knowledge towards the possibilities but I want to push it a little more on the search for a more vanilla approach before going there. I 've been looking into doing an add-method upon entering the environment, that will specialize on eql, and performing a remove-method upon exiting. I 've not finished yet . If anyone has played with those , comments would be nice. Will keep the thread up-to-date.
EDIT 2: I am close to do it with add-method scenario but there is a problem. Here is what I have tried:
(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)
)))
Calling (my-test) with some object slot and data as args results in:
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
So I am stuck here. Specialization works since applicable methods now include the eql-specialized :after method, but unfortunately it does not seem to get called. Can anyone help so I can finish with it and refactor it to a sweet little utility macro?
No, you cannot define a dynamic extent or lexically scoped specialized method in Common Lisp.
Aspect Oriented Programming can be used as an approach to solve the underlying problem. See also Context-Oriented Programming.
ContextL is a library that provides aspect/context -oriented extensions for Common Lisp / CLOS.
A light-weight alternative is to use a special/dynamic variable to indicate when the method should do the logging:
(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...))
Note though that the :around method will be called also when logging is disabled.