patch to victoria-day pcl

[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.

 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.

The following patch resolves both of these problems, at least for the
Franz Allegro/Sun-4 port.  I have made defgeneric a top-level form,
evaluated at the same times as defmethod; I parse the options list as
I interpret the CLOS spec, and I modified make-top-level-form to
return the value, at least in my port.  This latter change may be
bogus - I don't know what the purpose of the second eval-when is, but
I changed it as shown below and ran all the tests, and I also
compiled and tested my own extensive batch of CLOS code, and it seems
to work fine.  Maybe someone could enlighten me.

Thanks.
------------------------------------------------------------------------
     John Collins			Phone: +1 (612) 736 0778
     3M Company				FAX:   +1 (612) 733 2165
     3M Center, Building 260-6A-08	Internet: jecollins@mmm.serc.3M.com
     St. Paul, MN  55144-1000		UUCP: ...!uiucuxc!mmm!jecollins
------------------------------------------------------------------------

;;;  -*-  Package: PCL   Mode: COMMON-LISP  -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package :pcl)

;;; Make defgeneric accept options (at least the ones that actually work)
;;; These are the defgeneric options that seem to work --
(defvar *working-generic-function-options*
  '(:generic-function-class :method-class))

(defun expand-defgeneric (function-specifier lambda-list options)
  (make-top-level-form
   `(defgeneric ,function-specifier)
   '(compile load eval)
   `(load-defgeneric
     ',function-specifier
     ',lambda-list
     ,(cons 'list
	    (mapcan
	     #'(lambda (option)
		 (ecase option
		   ((:generic-function-class :method-class)
		    (let ((class-name (getf options option)))
		      (when class-name
			(list option `(find-class ',class-name)))))))
	     *working-generic-function-options*)))))

(defun load-defgeneric (function-specifier lambda-list options)
  (apply #'ensure-generic-function
	 `(,function-specifier
	   :lambda-list ,lambda-list
	   ,@options)))

;;; Change make-top-level-form so things like defclass and defmethod
;;; that use it return the correct values.  All I did was to add ExCL
;;; to the #- to block the eval-when ().  An alternative would be to
;;; return a prog1 form instead of the progn form; that makes the
;;; compiler complain about eval-when not at the top level, and
;;; doesn't seem to behave differently anyway, at least on the things
;;; I have tested it on.  That includes everything with "test" in its
;;; name in the victoria-day distribution.

(defun make-top-level-form (name times form)
  #+Genera `(top-level-form ,name ,times ,form)
  #-Genera
  (progn name
	 (make-progn
	  `(eval-when ,times ,form)
	  #-(or GCLisp :coral ExCL)
	  '(eval-when ()))))