Changeset 13184


Ignore:
Timestamp:
Nov 10, 2009, 2:26:38 PM (10 years ago)
Author:
gz
Message:

check method keyword args against global def if there is one

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/sysutils.lisp

    r13067 r13184  
    608608  (destructuring-bind (arglist spread-p) wargs
    609609    (multiple-value-bind (deftype reason) (nx1-check-call-args def arglist spread-p)
     610      (when (and (eq deftype :deferred-mismatch)
     611                 (eq (car reason) :unknown-gf-keywords)
     612                 (consp def)
     613                 (not (logbitp $lfbits-gfn-bit (def-info.lfbits (cdr def)))))
     614        ;; If didn't have a defgeneric, check against global defn
     615        (let* ((global-def (fboundp (car def)))
     616               (bad-keys (cadr reason)))
     617          (when (typep global-def 'generic-function)
     618            (setq bad-keys
     619                  (multiple-value-bind (bits keyvect) (innermost-lfun-bits-keyvect global-def)
     620                    (when (and bits
     621                               (logbitp  $lfbits-keys-bit bits)
     622                               (not (logbitp $lfbits-aok-bit bits)))
     623                      (loop for key in bad-keys
     624                        unless (or (find key keyvect)
     625                                   (nx1-valid-gf-keyword-p global-def key))
     626                        collect key)))))
     627          (if bad-keys
     628            (setq reason (list* :unknown-gf-keys bad-keys (cddr reason)))
     629            (setq deftype nil))))
    610630      (when deftype
    611631        (when (eq deftype :deferred-mismatch)
Note: See TracChangeset for help on using the changeset viewer.