X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fpcl%2Fdefcombin.lisp;h=0b2111edf0148512b895613ce3fca8f50fd56b7f;hb=56f96e77ade913d6363a3068c94e60f44ae9b3e7;hp=8c4bd49269975da702316e14953a8c51fbc3cf9d;hpb=0bca0cb1bf5ce5572ab5cd7ba59f87fed1f2edb0;p=sbcl.git

diff --git a/src/pcl/defcombin.lisp b/src/pcl/defcombin.lisp
index 8c4bd49..0b2111e 100644
--- a/src/pcl/defcombin.lisp
+++ b/src/pcl/defcombin.lisp
@@ -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)))
@@ -204,9 +208,10 @@
 			 (declare (ignore nms cm-args))
 			 (apply
 			  (lambda (generic-function type options)
-			    (declare (ignore generic-function options))
+			    (declare (ignore generic-function))
 			    (make-instance 'long-method-combination
 					   :type type
+					   :options options
 					   :documentation doc))
 			  args))
 	     :definition-source `((define-method-combination ,type)
@@ -226,10 +231,10 @@
 
 (defun make-long-method-combination-function
        (type ll method-group-specifiers args-option gf-var body)
-  ;;(declare (values documentation function))
   (declare (ignore type))
-  (multiple-value-bind (documentation declarations real-body)
-      (extract-declarations body)
+  (multiple-value-bind (real-body declarations documentation)
+      ;; (Note that PARSE-BODY ignores its second arg ENVIRONMENT.)
+      (parse-body body nil)
 
     (let ((wrapped-body
 	    (wrap-method-group-specifier-bindings method-group-specifiers