X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fmethods.lisp;h=9f43912edef5246e960ef919c442091a68c77904;hb=c41d75f1d2defd6234e644ef2b40440a5d1526c5;hp=e65ce45b6038e76fa350b03dc2df9cb05c6c1002;hpb=29a9ccc860532b32c566aec095f570e999a9c52c;p=sbcl.git

diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp
index e65ce45..9f43912 100644
--- a/src/pcl/methods.lisp
+++ b/src/pcl/methods.lisp
@@ -403,6 +403,14 @@
 	 (when restp
 	       `(&rest ,(intern "Discriminating Function &rest Arg")))))
 
+(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))
@@ -1204,7 +1211,7 @@
 					     meth generic-function))))
 				  (cddr form)))
 		    (default (car (last list))))
-	       (list (list* ':mcase mp (nbutlast list))
+	       (list (list* :mcase mp (nbutlast list))
 		     (cdr default))))
 	    (t
 	     (default-constant-converter form))))))
@@ -1224,7 +1231,7 @@
 
 (defun convert-table (constant method-alist wrappers)
   (cond ((and (consp constant)
-	      (eq (car constant) ':mcase))
+	      (eq (car constant) :mcase))
 	 (let ((alist (mapcar (lambda (k+m)
 				(cons (car k+m)
 				      (convert-methods (cdr k+m)
@@ -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))