Defgeneric and method classes (was: patch to victoria-day pcl)

[Martin Boyer <gamin@Moe.McRCIM.McGill.EDU>]

> Date: Mon, 27 Nov 89 18:01:50 CST
> From: us015029@serc.3m.com (John E. Collins)

> Faced with a strong desire to create and use subclasses of
> standard-method, I encountered two problems with Victoria-Day PCL.
> 
>  1. The defgeneric form does not accept options, especially the
>     :method-class option.

See below for a way around this using ensure-generic-function.

>  2. The defmethod form (and defclass and defgeneric), at least in the
>     Franz Allegro Common Lisp (Sun 4) port does not return its
>     specified value, but instead returns nil.  This means you have to
>     go through compute-applicable-methods or some such to get at the
>     method you just defined.
>
> [...]

mmm.  That is strange, it seems to work for me (Sun/Lucid 3.1).
See below how set-attributes-of-previous-method is implemented.
	
I ran into that problem a while ago and kanderso@bbn gave me a useful hint
(it's still probably somewhere in the mailing list archives on arisia);
ensure-generic-function takes the proper :method-class argument you're
looking for.  I've been using my own method classes for a while now with
great pleasure.  Here are some of the functions I've hacked to play with
those (the names have been changed to protect the innocent, so there may
be bugs, let me know if you get stuck).

MY-METHOD-CLASS is sort of a mixin, adding slots to those of the
standard-method class.  Look at the bottom for an example of how to use
the ensure-generic-function.  You might also be interested by the DESCRIBE
method which shows the precedence list up to standard-method (because
beyond that is uninteresting to me).

I've also hacked up Victoria Day to "get hold of the method object" while
executing a method (refer to the discussion of two weeks ago on this mailing
list).  It works fairly well, but it is a non-standard extension.  I think
we should be careful about that sort of "extensions" and for that reason,
I'll post it only tomorrow, after I've documented it adequately.

For now, I hope this can help you:

NOTE:  All references to internal PCL symbols are just that: references
       to symbols in ONE implementatino of CLOS; they are subject to
       change (though I suspect symbols such as generic-function-method-class
       are part of the unreleased Meta-Object Protocol, would anyone care
       to comment?).

;;; FIND-METHOD is not yet part of PCL.
;;; We use the (undocumented) get-method, which works the same way.
(setf (symbol-function 'find-method) (symbol-function 'pcl::get-method))

(defclass my-method-class
   (pcl::standard-method)

   ;; This slot hold everything *I* need for the demonstration.

   ( (type	 :accessor   method-type
		 :initarg  :type)
   )

   (:documentation
     "Superclass of all my interesting methods.")
)


;;;; DESCRIBE
;;; Specialize DESCRIBE for MY-METHODs.
;;;
(defmethod describe :before ((method my-method-class))

   (format t "~&~S is an instance of my methods.~2%"
	   method)

   (format t "This particular method models the class ~S of type ~S.~%"
	   (class-name (class-of method))
	   (method-type method))

   (let ((precedence-list
	     (mapcar 'class-name
		     (cdr (pcl::class-class-precedence-list (class-of method)))))
	 (ancestors ()))

       (setq ancestors
	     (loop for class in precedence-list
		   until (eql class 'my-method-class)
		   collecting class))
       (when (> (length ancestors) 1)
	   (format t "~%It inherits from the following:~%~{~S ~}" ancestors))
   )

   (values)
)


;;;; SET-ATTRIBUTES-OF-PREVIOUS-METHOD
;;; Takes any number of attributes (in the form of slot accessors) and values
;;; to define the attributes of the previously defined method (with DEFMETHOD).
;;; The attributes and values form lists.
;;;
;;; Note that since this macro uses the `*' variable,
;;; the macro must be evaluated immediately after the DEFMETHOD form.
;;;
;;; Also note that this is using the LOOP facility of Lucid Common LISP.
;;; 
;;; This macro returns nothing.
;;;
(defmacro SET-ATTRIBUTES-OF-PREVIOUS-METHOD (&body attributes)
   (let ((method *))
       (loop for attribute in attributes
	     doing (setf ((car attribute) method) (cadr attribute)))
       (values)
   )
)


;;; AN EXAMPLE:

;;; Suppose a particular method is different from all the others in its class.
;;; Once that method is defined, one needs to change the default parameters,
;;; SET-ATTRIBUTES-OF-PREVIOUS-METHOD is used to do it in this fashion:

(ensure-generic-function 'foo)
(setf (pcl::generic-function-method-class *) (find-class 'my-method-class))

(defmethod foo ( (object bar) )
   (values)
)

;;; Here we need to override the default values for the previous method

(set-attributes-of-previous-method
   (method-type	    'baz)
)