eql specializers

[harrisr@turing.cs.rpi.edu (Richard Harris)]

I sent this a few days ago and it seems to have vanished, so here it is again.

> Date: Mon, 8 Aug 88 17:34 PDT
> From: Gregor.pa@Xerox.COM
>    BUGS:
>
>    o specializer (eql fred) works but (eql 'fred) as in CLOS doesn't.
>
>This should work now.  What still is a problem is that eql methods don't
>work too well with method combination.
I don't understand what you mean here.  It appears to me as if eql specializers
are not getting evaluated, and I haven't found a problem with method combination.

Here is an example of what happens now: (with "8/28/88 (beta rev 1) AAAI PCL " and KCL)
 (macroexpand '(defmethod a ((b (eql 'c))) 'd))
=>
 (PROGN
   (EVAL-WHEN (COMPILE LOAD EVAL)
     (PROGN
       (PROGN
         (LOAD-DEFMETHOD 'STANDARD-METHOD 'A 'NIL '((EQL 'C)) '(B) 'NIL
             'NIL 'NIL #'(LAMBDA (B) (PROGN B) (BLOCK A 'D))))))
   (EVAL-WHEN ()))

 (defmethod a ((b (eql 'c))) 'd)
=>
 NIL

 (a 'c)
=>
 Error: No matching method for the generic-function #<compiled-closure A>
 when called with arguments (C).
 Error signalled by A.

 Broken at NO-APPLICABLE-METHOD.  Type :H for Help.


I think this problem can be fixed by changing expand-defmethod:
;From boot.lisp
(defun expand-defmethod (proto-method name qualifiers lambda-list body env)
  (multiple-value-bind (fn-form specializers doc plist)
      (expand-defmethod-internal name qualifiers lambda-list body env)
    (make-top-level-form (make-method-spec name qualifiers specializers)
			 '(compile load eval)
      `(progn
	 ,(make-progn
	    `(load-defmethod
	       ',(if proto-method
		     (class-name (class-of proto-method))
		     'standard-method)
	       ',name
	       ',qualifiers
	       ,(if (some #'(lambda (specializer)
			      (and (consp specializer)
				   (eq (car specializer) 'eql)))
			  specializers)
		    `(list ,@(mapcar #'(lambda (specializer)
					 (if (and (consp specializer)
						  (eq (car specializer) 'eql))
					     ``(eql ,,(cadr specializer))
					     `',specializer))
				     specializers))
		    `',specializers)
	       ',(specialized-lambda-list-lambda-list lambda-list)
	       ',doc
	       ',(getf plist :isl-cache-symbol)   ;Paper over a bug in KCL by
						  ;passing the cache-symbol
						  ;here in addition to in the
						  ;plist.
	       ',plist
	       ,fn-form))))))

With this patch:
 (macroexpand '(defmethod a ((b (eql 'c))) 'd))
=>
 (PROGN
   (EVAL-WHEN (COMPILE LOAD EVAL)
     (PROGN
       (PROGN
         (LOAD-DEFMETHOD 'STANDARD-METHOD 'A 'NIL (LIST (LIST 'EQL 'C))
              '(B) 'NIL 'NIL 'NIL #'(LAMBDA (B) (PROGN B) (BLOCK A 'D))))))
   (EVAL-WHEN ()))

 (defmethod a ((b (eql 'c))) 'd)
=>
 NIL

 (a 'c)
=>
 D

 ----
 Rick Harris