Attempting to circumvent Symbolics' Reader Method optimization

[basham@aio.jsc.nasa.gov (Bryan Basham)]

Hello SLUG,

I have written a piece of code that dependends on the reader methods to call
SLOT-VALUE.  However, I have discovered that Symbolics' MOP performs an
optimization (?) that does not call SLOT-VALUE.  I would like to circumvent
the "empty" creation of Reader Methods and place a real method (that calls
SLOT-VALUE in its place).

In the past week I have reviewed the following code:

  1) for class creation
     -- This lead me to the realization that although reader methods are created
     they are not used by the reader generic function.  Instead, slot access is
     handled by the function CLOS-INTERNALS::STANDARD-CLASS-SHARED-SLOT-READER
     (and is dispatched by: CLOS-INTERNALS::HANDLE-MISSED-DISPATCH).

  2) for reader method creation and insertion
     -- Here, I discovered the generic function COMPUTE-SLOT-METHODS, which is
     called by the SHARED-INITIALIZE (STANDARD-CLASS) after method, creates
     instances of STANDARD-READER-METHOD and adds the methods to the proper
     reader generic function, using ADD-METHOD.  This lead me to think that I
     could write an after method for ADD-METHOD that would insert the proper
     functional code.

  3) for method creation
     -- Here I discovered just how convoluted Symbolics' generic function/method
     implementation is.  The magical incantations that associate a real function
     to a method and then the method to a generic function is distributed over
     several files.

  4) for generic function dispatching
     -- I'm at a loss to figure out what's going on here.

My first attempt was to take the (empty) reader method and place a real function
in the function cell:
#|---------------------------------------------------------------------------------------------
CLOS:add-method (generic.function STANDARD-GENERIC-FUNCTION)			 [after Method]
		(method STANDARD-READER-METHOD)
Argument List:
  generic.function
  method
Purpose: This method ensures that all QuasiObject reader methods call SLOT-VALUE.
Portability: WARNING -- This is a minor hack to the Symbolics implementation of CLOS.  It
  enforces the existance a real function in the reader method's of QuasiObjects.
|#;;;;;;;;
#+Symbolics
(defmethod CLOS:add-method :after ((generic.function STANDARD-GENERIC-FUNCTION)
				   (method CLOS:STANDARD-READER-METHOD))
    (when (QO-Compatible-Class-p (first (CLOS:method-specializers method)))
       (let ((function (CLOS-INTERNALS::make-standard-method-lambda
			   `(lambda (instance)
			      (slot-value instance ',(CLOS:method-slot-name method))))))
	 ;; This uses some code found in the SHARED-INITIALIZE (STANDARD-METHOD) after method.
	 (setf (slot-value method 'CLOS-INTERNALS::function-parent)
	         `(method ,(CLOS:generic-function-name generic.function)
			  (,(class-name (first (CLOS:method-specializers method)))))
	       (SYS:function-name function)
		 method
	       (CLOS-INTERNALS::fdefinition-in-environment method NIL)
	         (compile NIL function)))

This never really did anything; which lead me to think that a lot more information/computation
was being used to "connect" the method's function to the method (and/or generic function).
I then try to get closer to what the DEFMETHOD macro (and CLOS-INTERNALS::DEFMETHOD-INTERNAL
function) were doing.  Crucial to this was the use of the CLOS-INTERNALS::PARSE-METHOD
function.  This was my second attempt:
#|---------------------------------------------------------------------------------------------
CLOS:add-method (generic.function STANDARD-GENERIC-FUNCTION)			[around Method]
		(method STANDARD-READER-METHOD)
Argument List:
  generic.function
  method
Purpose: This method ensures that all QuasiObject reader methods call SLOT-VALUE.
Portability: WARNING -- This is a minor hack to the Symbolics implementation of CLOS.  It
  enforces the existance a real function in the reader method's of QuasiObjects.
|#;;;;;;;;
#+Symbolics
(defmethod CLOS:add-method :around ((generic.function STANDARD-GENERIC-FUNCTION)
				    (method CLOS:STANDARD-READER-METHOD))
    (if (QO-Compatible-Class-p (first (CLOS:method-specializers method)))
	;THEN, make a new method to be added
	(let ((name (list 'method (CLOS:generic-function-name generic.function) ()))
	      (form `(;;Specialized lambda list
		      ((instance ,(class-name (first (CLOS:method-specializers method)))))
		        ;;Method body
			(slot-value instance ',(CLOS:method-slot-name method)))))
	  (flet ((finder (function.name lambda.list)
		  (declare (ignore lambda.list))
		   (let ((GF (ensure-generic-function function.name)))
		     (values GF (CLOS:class-prototype (CLOS:generic-function-method-class GF))))))
	    (call-next-method generic.function
	      (make-instance (CLOS:generic-function-method-class generic.function)
			     :SPECIALIZERS (CLOS:method-specializers method)
			     :LAMBDA-LIST '(instance)
			     :FUNCTION (compile NIL
					 (fifth (multiple-value-list
						  (CLOS-INTERNALS::parse-method
						        name form #'finder NIL #'warn))))
			     'CLOS-INTERNALS::no-next-method-information T))))
	;ELSE
	(call-next-method)))

Here, I tried to create a new method object to replace the useless one that was
initially passed to ADD-METHOD.  This approach never really worked either.

Any ideas and/or approaches would be greatly appreciated.

-Bryan Basham

/-------------------------------------------------/
/  Bryan D. Basham				  /
/  NASA/JSC  Mail Stop: ER22,  Houston TX  77058  /
/  (713) 483-2065				  /
/  Basham@AIO.JSC.NASA.GOV			  /
/-------------------------------------------------/