X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/1ec065092f42b4b0be3dcb833f3f5f24451701fd..2c6153373f927d948a74b283ebb16330af8ee49a:/src/method-impl.lisp

diff --git a/src/method-impl.lisp b/src/method-impl.lisp
index 91c22bb..f2d71aa 100644
--- a/src/method-impl.lisp
+++ b/src/method-impl.lisp
@@ -272,6 +272,9 @@
 			     (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)
@@ -288,7 +291,7 @@
 
 (export '(basic-effective-method
 	  effective-method-around-methods effective-method-before-methods
-	  effective-method-after-methods))
+	  effective-method-after-methods effective-method-functions))
 (defclass basic-effective-method (effective-method)
   ((around-methods :initarg :around-methods :initform nil
 		   :type list :reader effective-method-around-methods)
@@ -520,6 +523,38 @@
 						   set "v->kw")))
 	  (name (effective-method-keyword-parser-function-name method)))
 
+      ;; Deal with the special `kw.' keywords read via varargs.  We're
+      ;; building the dispatch up backwards, so if we do these first, they
+      ;; get checked last, which priviliges the function-specific arguments
+      ;; over these special effects.
+      (codegen-push codegen)
+      (call "vv" "va_arg" "*ap" (c-type (* (struct "kwval" :const))))
+      (call "nn" "va_arg" "*ap" c-type-size-t)
+      (call :void name "kw" *null-pointer* "vv" "nn")
+      (setf va-act (namecheck "k" "kw.tab"
+			      (codegen-pop-block codegen) va-act))
+
+      (codegen-push codegen)
+      (call "aap" "va_arg" "*ap" (c-type (* va-list)))
+      (call :void name "kw" "aap" *null-pointer* 0)
+      (setf va-act (namecheck "k" "kw.valist"
+			      (codegen-pop-block codegen) va-act))
+
+      ;; Deal with the special `kw.' keywords read from a table.
+      (codegen-push codegen)
+      (deliver-expr codegen "t"
+		    (format nil "(~A)v->val"
+			    (c-type (* (struct "kwtab" :const)))))
+      (call :void name "kw" *null-pointer* "t->v" "t->n")
+      (setf tab-act (namecheck "v->kw" "kw.tab"
+			       (codegen-pop-block codegen) tab-act))
+
+      (codegen-push codegen)
+      (convert "aap" (c-type (* va-list)))
+      (call :void name "kw" "aap" *null-pointer* 0)
+      (setf tab-act (namecheck "v->kw" "kw.valist"
+			       (codegen-pop-block codegen) tab-act))
+
       ;; Work through the keywords.  We're going to be building up the
       ;; conditional dispatch from the end, so reverse the (nicely sorted)
       ;; list before processing it.
@@ -541,20 +576,6 @@
 	  (setf tab-act (namecheck "v->kw" key-name
 				   (codegen-pop-block codegen) tab-act))))
 
-      ;; Deal with the special `kw.' keywords read via varargs.
-      (codegen-push codegen)
-      (call "vv" "va_arg" "*ap" (c-type (* (struct "kwval" :const))))
-      (call "nn" "va_arg" "*ap" c-type-size-t)
-      (call :void name "kw" *null-pointer* "vv" "nn")
-      (setf va-act (namecheck "k" "kw.tab"
-			      (codegen-pop-block codegen) va-act))
-
-      (codegen-push codegen)
-      (call "aap" "va_arg" "*ap" (c-type (* va-list)))
-      (call :void name "kw" "aap" *null-pointer* 0)
-      (setf va-act (namecheck "k" "kw.va_list"
-			      (codegen-pop-block codegen) va-act))
-
       ;; Finish up the varargs loop.
       (emit-banner codegen "Parse keywords from the variable-length tail.")
       (codegen-push codegen)
@@ -565,23 +586,8 @@
 	(emit-inst codegen
 		   (make-if-inst "ap" (make-block-inst nil (list loop)))))
 
-      ;; Deal with the special `kw.' keywords read from a table.
-      (codegen-push codegen)
-      (deliver-expr codegen "t"
-		    (format nil "(~A)v->val"
-			    (c-type (* (struct "kwtab" :const)))))
-      (call :void name "kw" *null-pointer* "t->v" "t->n")
-      (setf tab-act (namecheck "v->kw" "kw.tab"
-			       (codegen-pop-block codegen) tab-act))
-
-      (emit-banner codegen "Parse keywords from the argument table.")
-      (codegen-push codegen)
-      (convert "aap" (c-type (* va-list)))
-      (call :void name "kw" "aap" *null-pointer* 0)
-      (setf tab-act (namecheck "v->kw" "kw.va_list"
-			       (codegen-pop-block codegen) tab-act))
-
       ;; Finish off the table loop.
+      (emit-banner codegen "Parse keywords from the argument table.")
       (codegen-push codegen)
       (emit-inst codegen tab-act)
       (emit-inst codegen (make-expr-inst "v++"))