Re: Getting hold of the method object currently executed

[Gregor.pa@Xerox.COM]

    Date: Wed, 15 Nov 89 09:51:13 EST
    From: Martin Boyer <gamin@Moe.McRCIM.McGill.EDU>

    In Victoria Day PCL, is it possible, from the body of a method, to
    reference the method object itself?

And now, for the grim truth about what you have to do in Victoria Day.

Assuming that you fall into the degenerate case as described in my
previous message, there is a hack change you can make which will win
pretty well.  It is simple, and shouldn't affect performance too much.
It will also make the variable *method-being-run* available in every
method in the world without having to declare the method combination
type or the class of the generic function (which is good since you can't
do that in victoria day PCL).  But this variable will only be correct
when you are in the degenerate case of course.

If you don't fall into the degenerate case you will have to fix
add-lexical-functions-to-method-lambda and make-code-constructor in an
anlogous way.

Note, I haven't tested this, sorry.

;from combin.lisp

(proclaim '(special *method-being-run*))

(defun make-effective-method-function (generic-function form)
  (declare (ignore generic-function))
  (flet ((name-function (fn)
	   (set-function-name fn 'a-combined-method)
	   fn))
    (if (and (listp form)
	     (eq (car form) 'call-method)
	     (method-p (cadr form))
	     (every #'method-p (caddr form)))
	;; The effective method is just a call to call-method.  This opens
	;; up a possibility of just using the method function of the method
	;; being called as the effective method function.
	;;
	;; But we have to be careful.  We must be sure to communicate the
	;; next methods to the method if it needs them.  If there are no
	;; next methods we must communicate that fact to prevent the leaky
	;; next methods bug.
	(let* ((method (cadr form))
	       (method-function (method-function method))
	       (next-method-functions	
		 (mapcar #'method-function (caddr form))))
	  (name-function
	    #'(lambda (&rest .combined-method-args.)
		(let ((*method-being-run* method)
		      (*next-methods* next-method-functions))
		  (apply method-function .combined-method-args.)))))
	(name-function
	  (funcall (get-effective-method-code-constructor form) form)))))
-------