0.7.9.14:

[sbcl.git] / src / pcl / methods.lisp

diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp
index 091c514..9f43912 100644 (file)
--- a/src/pcl/methods.lisp
+++ b/src/pcl/methods.lisp
@@ -403,6 +403,14 @@
         (when restp
               `(&rest ,(intern "Discriminating Function &rest Arg")))))
 \f
+(defmethod generic-function-argument-precedence-order
+    ((gf standard-generic-function))
+  (aver (eq *boot-state* 'complete))
+  (loop with arg-info = (gf-arg-info gf)
+       with lambda-list = (arg-info-lambda-list arg-info)
+       for argument-position in (arg-info-precedence arg-info)
+       collect (nth argument-position lambda-list)))
+
 (defmethod generic-function-lambda-list ((gf generic-function))
   (gf-lambda-list gf))
 
@@ -508,19 +516,19 @@
 (defun compute-applicable-methods-function (generic-function arguments)
   (values (compute-applicable-methods-using-types
           generic-function
-          (types-from-arguments generic-function arguments 'eql))))
+          (types-from-args generic-function arguments 'eql))))
 
 (defmethod compute-applicable-methods
     ((generic-function generic-function) arguments)
   (values (compute-applicable-methods-using-types
           generic-function
-          (types-from-arguments generic-function arguments 'eql))))
+          (types-from-args generic-function arguments 'eql))))
 
 (defmethod compute-applicable-methods-using-classes
     ((generic-function generic-function) classes)
   (compute-applicable-methods-using-types
    generic-function
-   (types-from-arguments generic-function classes 'class-eq)))
+   (types-from-args generic-function classes 'class-eq)))
 
 (defun proclaim-incompatible-superclasses (classes)
   (setq classes (mapcar (lambda (class)
@@ -595,8 +603,7 @@
         function
         n))
 
-(defun types-from-arguments (generic-function arguments
-                            &optional type-modifier)
+(defun types-from-args (generic-function arguments &optional type-modifier)
   (multiple-value-bind (nreq applyp metatypes nkeys arg-info)
       (get-generic-fun-info generic-function)
     (declare (ignore applyp metatypes nkeys))
@@ -1301,7 +1308,7 @@
     (format t "~&make-unordered-methods-emf ~S~%"
            (generic-function-name generic-function)))
   (lambda (&rest args)
-    (let* ((types (types-from-arguments generic-function args 'eql))
+    (let* ((types (types-from-args generic-function args 'eql))
           (smethods (sort-applicable-methods generic-function
                                              methods
                                              types))