X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/12386a2694932857981a076536c6297f8eaa661f..4faea17df1052a4c4f44f75b6ed537ebe9598c24:/src/method-proto.lisp

diff --git a/src/method-proto.lisp b/src/method-proto.lisp
index 637c29e..5687802 100644
--- a/src/method-proto.lisp
+++ b/src/method-proto.lisp
@@ -49,6 +49,61 @@
    will be a list of applicable methods sorted in most-to-least specific
    order."))
 
+(export 'sod-message-applicable-methods)
+(defgeneric sod-message-applicable-methods (message class)
+  (:documentation
+   "Return a list of applicable methods for a MESSAGE.
+
+   The list contains all methods applicable for MESSAGE when sent to an
+   instance of CLASS, most specific first."))
+
+(export 'sod-message-keyword-argument-lists)
+(defgeneric sod-message-keyword-argument-lists
+    (message class direct-methods state)
+  (:documentation
+   "Returns a list of keyword argument lists to be merged.
+
+   This should return a list suitable for passing to `merge-keyword-lists',
+   i.e., each element should be a pair consisting of a function describing
+   the source of the argument list (returning location and description), and
+   a list of `argument' objects.
+
+   The MESSAGE is the message being processed; CLASS is a receiver class
+   under consideration; DIRECT-METHODS is the complete list of applicable
+   direct methods (most specific first); and STATE is an `inheritance-path-
+   reporter-state' object which can be used by the returned reporting
+   functions."))
+
+(export 'compute-effective-method-keyword-arguments)
+(defun compute-effective-method-keyword-arguments
+    (message class direct-methods)
+  "Return a merged keyword argument list.
+
+   The returned list combines all of the applicable methods, provided as
+   DIRECT-METHODS, applicable to MESSAGE when received by an instance of
+   CLASS, possibly with other keywords as determined by `sod-keyword-
+   argument-lists'."
+  (let ((state (make-inheritance-path-reporter-state class)))
+    (merge-keyword-lists (lambda ()
+			   (values class
+				   (format nil
+					   "methods for message `~A' ~
+					    applicable to class `~A'"
+					   message class)))
+			 (sod-message-keyword-argument-lists message
+							     class
+							     direct-methods
+							     state))))
+
+(export 'sod-message-check-methods)
+(defgeneric sod-message-check-methods (message class direct-methods)
+  (:documentation
+   "Check that the applicable methods for a MESSAGE are compatible.
+
+   Specifically, given the DIRECT-METHODS applicable for the message when
+   received by an instance of CLASS, signal errors if the methods don't
+   match the MESSAGE or each other."))
+
 (export 'sod-message-effective-method-class)
 (defgeneric sod-message-effective-method-class (message)
   (:documentation
@@ -63,15 +118,6 @@
 
    This protocol is used by `simple-message' subclasses."))
 
-(export 'method-keyword-argument-lists)
-(defgeneric method-keyword-argument-lists (method direct-methods)
-  (:documentation
-   "Returns a list of keyword argument lists to be merged.
-
-   This should return a list suitable for passing to `merge-keyword-lists',
-   i.e., each element should be a pair consisting of a list of `argument'
-   objects and a string describing the source of the argument list."))
-
 (export 'compute-sod-effective-method)
 (defgeneric compute-sod-effective-method (message class)
   (:documentation
@@ -147,6 +193,16 @@
 
    No `me' argument is prepended; any `:ellipsis' is left as it is."))
 
+(export 'sod-method-description)
+(defgeneric sod-method-description (method)
+  (:documentation
+   "Return an adjectival phrase describing METHOD.
+
+    The result will be placed into an error message reading something like
+    ``Conflicting definition of DESCRIPTION direct method `bogus'''.  Two
+    direct methods which can coexist in the same class, defined on the same
+    message, should have differing descriptions."))
+
 (export 'sod-method-function-type)
 (defgeneric sod-method-function-type (method)
   (:documentation
@@ -290,14 +346,10 @@
 
 ;;; Utilities.
 
-(defvar *keyword-struct-disposition* :unset
+(defvar-unbound *keyword-struct-disposition*
   "The current state of the keyword structure.
 
-   This can be one of four values.
-
-     * `:unset' -- the top-level default, mostly because I can't leave it
-       unbound and write this documentation.  Nothing that matters should see
-       this state.
+   This can be one of three values.
 
      * `:local' -- the structure itself is in a local variable `sod__kw'.
        This is used in the top-level effective method.
@@ -432,11 +484,13 @@
 					   :pointer :null)))
     (codegen-push codegen)
     (ensure-ilayout-var codegen super)
-    (when (and (keyword-message-p message)
-	       (not (eq *keyword-struct-disposition* :null)))
-      (let ((tag (effective-method-keyword-struct-tag method)))
-	(ensure-var codegen *sod-keywords* (c-type (* (struct tag :const)))
-		    *sod-key-pointer*)))
+    (when (keyword-message-p message)
+      (if (eq *keyword-struct-disposition* :null)
+	  (deliver-call codegen :void "SOD__IGNORE" *sod-key-pointer*)
+	  (let ((tag (effective-method-keyword-struct-tag method)))
+	    (ensure-var codegen *sod-keywords*
+			(c-type (* (struct tag :const)))
+			*sod-key-pointer*))))
     (funcall body (codegen-target codegen))
     (codegen-pop-function codegen (temporary-function)
 			  (c-type (fun (lisp return-type)