Re: generic dispatch doesn't work always

[bill@cambridge.apple.com]

>I am programming no-applicable method to forward calls that cannot be
>handled by some objects. I am in trouble, however, since the generic
>dispatch doesn't work in the following case:
>
>(defclass z-class () ())
>(defmethod z-method ((self integer) &key x-key)
>  x-key)
>(setq z (make-instance 'z-class))
>(z-method z :my-key 'foo)
>
>> Error: Bad keyword :MY-KEY to #<Compiled Generic-function Z-METHOD
>#x36BF7E>.
>>        arglist: (#<Z-CLASS #x36D281> :MY-KEY FOO)
>>        Allowable keys: #()
>> While executing: CCL::%CHECK-KEYWORDS-BAD-KEY
>> Type Command-. to abort.
>
>Instead of error "Bad keyword" it should call no-applicable-method. Because
>it traps to an error before that I can't do anything. It happens if there
>are keyword options in the call. I checked the same case on Symbolics where
>it works as it should.
>
>Matti Karjalainen
>Helsinki University of Technology

I believe MCL follows the letter of the law in this regard while Symbolics
does not. CLtL2 p. 793 says, "If a generic function is passed a keyword
argument that no applicable method accepts, an error is signaled." I can,
however, understand that it is more useful to call no-applicable-method
than to signal the bad keyword error. The fix is easy. Here's a patch
(included as source as there are a number of versions out there with
incompatible FASL formats):

--------------------------------------------------------------

; bad-keyword-patch.lisp
;
; call NO-APPLICABLE-METHOD instead of signalling a bad keyword error for
; the following code:
#|
(defclass z-class () ())
(defmethod z-method ((self integer) &key x-key)
  x-key)
(setq z (make-instance 'z-class))
(z-method z :my-key 'foo)
|#

(in-package :ccl)

(let ((*warn-if-redefine* nil)
      (*warn-if-redefine-kernel* nil))

(defun make-standard-combined-method (methods cpls gf)
  (unless (null cpls)
    (setq methods (sort-methods 
                   methods cpls (%gf-precedence-list (combined-method-gf gf)))))
  (let* ((keywords (compute-allowable-keywords-vector gf methods))
         (combined-method (make-standard-combined-method-internal
                           methods gf keywords)))
    (if (and keywords methods)
      (make-keyword-checking-combined-method gf combined-method keywords)
      combined-method)))

)