Changeset 13992


Ignore:
Timestamp:
07/04/12 21:13:59 (8 years ago)
Author:
rschlatte
Message:

Call compute-applicable-methods-using-classes

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r13991 r13992  
    16221622          (when mc-p
    16231623            (error "Preliminary ensure-method does not support :method-combination argument."))
    1624           (setf gf (apply (if (eq generic-function-class +the-standard-generic-function-class+)
     1624          (setf gf (apply (if (eq generic-function-class
     1625                                  +the-standard-generic-function-class+)
    16251626                              #'make-instance-standard-generic-function
    16261627                              #'make-instance)
     
    22232224(defun method-applicable-using-classes-p (method classes)
    22242225  (do* ((specializers (method-specializers method) (cdr specializers))
    2225   (classes classes (cdr classes))
    2226   (knownp t))
     2226        (classes classes (cdr classes))
     2227        (knownp t))
    22272228       ((null specializers)
    2228   (if knownp (values t t) (values nil nil)))
     2229        (if knownp (values t t) (values nil nil)))
    22292230    (let ((specializer (car specializers)))
    22302231      (if (typep specializer 'eql-specializer)
    2231     (if (eql (class-of (eql-specializer-object specializer))
    2232        (car classes))
    2233         (setf knownp nil)
    2234         (return (values nil t)))
    2235     (unless (subclassp (car classes) specializer)
    2236       (return (values nil t)))))))
     2232          (if (eql (class-of (eql-specializer-object specializer))
     2233                   (car classes))
     2234              (setf knownp nil)
     2235              (return (values nil t)))
     2236          (unless (subclassp (car classes) specializer)
     2237            (return (values nil t)))))))
    22372238
    22382239(defun check-applicable-method-keyword-args (gf args
     
    22802281          (if (eq (class-of gf) +the-standard-generic-function-class+)
    22812282              (std-compute-applicable-methods gf args)
    2282               (compute-applicable-methods gf args))))
     2283              (or (compute-applicable-methods-using-classes gf (mapcar #'class-of args))
     2284                  (compute-applicable-methods gf args)))))
    22832285    (if applicable-methods
    2284         (let* ((emfun (funcall (if (eq (class-of gf) +the-standard-generic-function-class+)
     2286        (let* ((emfun (funcall (if (eq (class-of gf)
     2287                                       +the-standard-generic-function-class+)
    22852288                                   #'std-compute-effective-method
    22862289                                   #'compute-effective-method)
    22872290                               gf (generic-function-method-combination gf)
    22882291                               applicable-methods))
    2289                (non-keyword-args
    2290                 (+ (length (gf-required-args gf))
    2291                    (length (gf-optional-args gf))))
     2292               (non-keyword-args (+ (length (gf-required-args gf))
     2293                                    (length (gf-optional-args gf))))
    22922294               (gf-lambda-list (generic-function-lambda-list gf))
    22932295               (checks-required (and (member '&key gf-lambda-list)
    22942296                                     (not (member '&allow-other-keys
    2295                                                   gf-lambda-list)))
    2296                  )
     2297                                                  gf-lambda-list))))
    22972298              (applicable-keywords
    22982299               (when checks-required
     
    23142315          (if (eq (class-of gf) +the-standard-generic-function-class+)
    23152316              (std-compute-applicable-methods gf (list arg))
    2316               (compute-applicable-methods gf (list arg)))))
     2317              (or (compute-applicable-methods-using-classes gf (list (class-of arg)))
     2318                  (compute-applicable-methods gf (list arg))))))
    23172319    (if applicable-methods
    2318         (let ((emfun (funcall (if (eq (class-of gf) +the-standard-generic-function-class+)
     2320        (let ((emfun (funcall (if (eq (class-of gf)
     2321                                      +the-standard-generic-function-class+)
    23192322                                  #'std-compute-effective-method
    23202323                                  #'compute-effective-method)
     
    34033406                                                    initargs))
    34043407             (mapcan #'(lambda (gf)
    3405                          (if (eq (class-of gf) +the-standard-generic-function-class+)
     3408                         (if (eq (class-of gf)
     3409                                 +the-standard-generic-function-class+)
    34063410                             (std-compute-applicable-methods gf args)
    34073411                             (compute-applicable-methods gf args)))
Note: See TracChangeset for help on using the changeset viewer.