Re: Question about methods

[Gregor.pa@Xerox.COM]

    Date: Wed, 3 Jan 90 13:20:46 PST
    From: Peter Benson <pab@lucid.com>

       Date: Wed, 3 Jan 90 14:02:27 -0500
       From: Arun Welch <welch@cis.ohio-state.edu>

       Given a method, I'd like to put a wrapper on it such that the result
       of calling the method is printed out to *trace-output*. 

    In general the closest thing to "the right thing" would probably be:

    (defmethod foo :around ((bar some-object))
      (let ((results (multiple-value-list (call-next-method))))
	(print (car results) *trace-output*)
	;; and anything else you want with results
	(values-list results)))

    This is not perfect because FOO may already have an :AROUND method for
    SOME-OBJECTs.

    If you know FOO on SOME-OBJECT *ALWAYS* returns one value then your
    definition will work. 

    This is kind of a drag because it clearly conses.  

Personally, I don't like this solution very much.  It has the problems
you mention, and a number of related ones as well.  What if you aren't
using STANDARD method combination?  Or what if the method you want to
trace is itself a :BEFORE, :AFTER or :AROUND method.

Following is a solution I like much better.  It creates a new method
object which encapsulates the one you want to trace.  The new method
object pretends to have the same qualifiers, specializers and all the
same as the old.  The one difference is that the function it returns
does tracing as well.

Some user interface could be added to this to make it easier to use. 
I haven't done that here because the vagaries of connecting to each
implementations trace facility cloud the code too much.

(defclass tracer-method (method)
     ((traced-method :initarg :traced-method
		     :reader traced-method)
      (function :initarg :function
		:reader method-function)
      (generic-function :initform nil
			:accessor method-generic-function)))

(defmethod method-lambda-list ((m tracer-method))
  (with-slots (traced-method) m (method-lambda-list traced-method)))

(defmethod method-specializers ((m tracer-method))
  (with-slots (traced-method) m (method-specializers traced-method)))

(defmethod method-qualifiers ((m tracer-method))
  (with-slots (traced-method) m (method-qualifiers traced-method)))

(defmethod method-qualifiers ((m tracer-method))
  (with-slots (traced-method) m (method-qualifiers traced-method)))

(defmethod accessor-method-slot-name ((m tracer-method))
  (with-slots (traced-method) m (accessor-method-slot-name traced-method)))

(defmethod trace-method ((method method))
  (let ((gfun (method-generic-function method))
	(mfun (method-function method))
	(tracer ()))
    (setq tracer
	  (make-instance
	    'tracer-method
	    :traced-method method
	    :function #'(lambda (&rest args)
			  (format *trace-output* "Calling ~S" method)
			  (apply-method-function gfun method mfun args))))
    (remove-method gfun method)
    (add-method gfun tracer)))

(defmethod untrace-method ((tracer tracer-method))
  (let ((gf (method-generic-function tracer)))
    (remove-method gf tracer)
    (add-method gf (traced-method tracer))))

;;;
;;; This is to win in systems without apply-method-function.
;;; 
(defun apply-method-function (gfun method function args)
  (apply function args))
-------