Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl/src/pcl
In directory usw-pr-cvs1:/tmp/cvs-serv16580/src/pcl

Modified Files:
	combin.lisp defcombin.lisp 
Log Message:
0.7.4.39:
	merged pmai patch (sbcl-devel 2002-06-18) for bug 180 (where
		:MOST-SPECIFIC-LAST options were ignored in method
		combination)


Index: combin.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/combin.lisp,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- combin.lisp	26 Jan 2002 17:10:32 -0000	1.14
+++ combin.lisp	18 Jun 2002 17:45:15 -0000	1.15
@@ -351,9 +351,10 @@
 	   (let ((main-effective-method
 		   (if (or before after)
 		       `(multiple-value-prog1
-			  (progn ,(make-call-methods before)
-				 (call-method ,(first primary)
-					      ,(rest primary)))
+			  (progn
+			    ,(make-call-methods before)
+			    (call-method ,(first primary)
+					 ,(rest primary)))
 			  ,(make-call-methods (reverse after)))
 		       `(call-method ,(first primary) ,(rest primary)))))
 	     (if around

Index: defcombin.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/defcombin.lisp,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- defcombin.lisp	16 Jan 2002 15:40:15 -0000	1.9
+++ defcombin.lisp	18 Jun 2002 17:45:15 -0000	1.10
@@ -124,6 +124,7 @@
   (let ((type (method-combination-type combin))
 	(operator (short-combination-operator combin))
 	(ioa (short-combination-identity-with-one-argument combin))
+	(order (car (method-combination-options combin)))
 	(around ())
 	(primary ()))
     (dolist (m applicable-methods)
@@ -147,8 +148,11 @@
 		 (push m primary))
 		(t
 		 (lose m "has an illegal qualifier"))))))
-    (setq around (nreverse around)
-	  primary (nreverse primary))
+    (setq around (nreverse around))
+    (ecase order
+      (:most-specific-last) ; nothing to be done, already in correct order
+      (:most-specific-first
+       (setq primary (nreverse primary))))
     (let ((main-method
 	    (if (and (null (cdr primary))
 		     (not (null ioa)))