X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/3a774b55edfea441c1715994924c2999e9202143..7702b7bc88a97c15f955f62e8afbc40521ceec7b:/src/method-impl.lisp

diff --git a/src/method-impl.lisp b/src/method-impl.lisp
index e93fb3a..6c751a4 100644
--- a/src/method-impl.lisp
+++ b/src/method-impl.lisp
@@ -249,29 +249,32 @@ (define-on-demand-slot delegating-direct-method function-type (method)
 ;;;--------------------------------------------------------------------------
 ;;; Effective method classes.
 
-(defmethod method-keyword-argument-lists
-    ((method effective-method) direct-methods state)
-  (with-slots (message) method
-    (and (keyword-message-p message)
-	 (cons (cons (lambda (arg)
-		       (let ((class (sod-message-class message)))
-			 (info-with-location
-			  message "Type `~A' declared in message ~
-				   definition in `~A' (here)"
-			  (argument-type arg) class)
-			 (report-inheritance-path state class)))
-		     (c-function-keywords (sod-message-type message)))
-	       (mapcar (lambda (m)
-			 (cons (lambda (arg)
-				 (let ((class (sod-method-class m)))
-				   (info-with-location
-				    m "Type `~A' declared in ~A direct ~
-				       method of `~A' (defined here)"
-				    (argument-type arg)
-				    (sod-method-description m) class)
-				   (report-inheritance-path state class)))
-			       (c-function-keywords (sod-method-type m))))
-		       direct-methods)))))
+(defmethod sod-message-keyword-argument-lists
+    ((message sod-message) (class sod-class) direct-methods state)
+  (and (keyword-message-p message)
+       (cons (cons (lambda (arg)
+		     (let ((class (sod-message-class message)))
+		       (info-with-location
+			message "Type `~A' declared in message ~
+				 definition in `~A' (here)"
+			(argument-type arg) class)
+		       (report-inheritance-path state class)))
+		   (c-function-keywords (sod-message-type message)))
+	     (mapcar (lambda (method)
+		       (cons (lambda (arg)
+			       (let ((class (sod-method-class method)))
+				 (info-with-location
+				  method "Type `~A' declared in ~A direct ~
+					  method of `~A' (defined here)"
+				  (argument-type arg)
+				  (sod-method-description method) class)
+				 (report-inheritance-path state class)))
+			     (c-function-keywords (sod-method-type method))))
+		     direct-methods))))
+
+(defmethod sod-message-check-methods
+    ((message sod-message) (class sod-class) direct-methods)
+  (compute-effective-method-keyword-arguments message class direct-methods))
 
 (defmethod shared-initialize :after
     ((method effective-method) slot-names &key direct-methods)
@@ -282,15 +285,9 @@ (defmethod shared-initialize :after
   ;; class construction.
   (with-slots ((class %class) message keywords) method
     (setf keywords
-	  (merge-keyword-lists
-	   (lambda ()
-	     (values class
-		     (format nil
-			     "methods for message `~A' ~
-			      applicable to class `~A'"
-			     message class)))
-	   (method-keyword-argument-lists method direct-methods
-	    (make-inheritance-path-reporter-state class))))))
+	  (compute-effective-method-keyword-arguments message
+						      class
+						      direct-methods))))
 
 (export '(basic-effective-method
 	  effective-method-around-methods effective-method-before-methods