doc/sod.tex: Don't print the `Index' header in uppercase.

[sod] / src / method-proto.lisp

diff --git a/src/method-proto.lisp b/src/method-proto.lisp
index 048c9249d3471f0f67eb402e419fd1a0b30d85fe..f7f1f474b8a9e93dfee6d60ac9ce9f6d2e4d6a6d 100644 (file)
--- a/src/method-proto.lisp
+++ b/src/method-proto.lisp
@@ -64,13 +64,19 @@ (defgeneric primary-method-class (message)
    This protocol is used by `simple-message' subclasses."))
 
 (export 'method-keyword-argument-lists)
    This protocol is used by `simple-message' subclasses."))
 
 (export 'method-keyword-argument-lists)

-(defgeneric method-keyword-argument-lists (method direct-methods)
+(defgeneric method-keyword-argument-lists (method 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',
   (: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."))
+   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 METHOD is the effective method being processed; 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-sod-effective-method)
 (defgeneric compute-sod-effective-method (message class)
 
 (export 'compute-sod-effective-method)
 (defgeneric compute-sod-effective-method (message class)


@@ -147,6 +153,16 @@ (defgeneric sod-message-argument-tail (message)
 
    No `me' argument is prepended; any `:ellipsis' is left as it is."))
 
 
    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
 (export 'sod-method-function-type)
 (defgeneric sod-method-function-type (method)
   (:documentation


@@ -290,14 +306,10 @@ (definst convert-to-ilayout (stream :export t)
 
 ;;; Utilities.
 
 
 ;;; Utilities.
 

-(defvar *keyword-struct-disposition* :unset
+(defvar-unbound *keyword-struct-disposition*

   "The current state of the keyword structure.
 
   "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.
 
      * `:local' -- the structure itself is in a local variable `sod__kw'.
        This is used in the top-level effective method.


@@ -428,14 +440,17 @@ (defun make-trampoline (codegen super body)
                           (cons (make-argument *sod-key-pointer*
                                                (c-type (* (void :const))))
                                 raw-args))))
                           (cons (make-argument *sod-key-pointer*
                                                (c-type (* (void :const))))
                                 raw-args))))

-        (*keyword-struct-disposition* t))
+        (*keyword-struct-disposition* (if (effective-method-keywords method)
+                                          :pointer :null)))

     (codegen-push codegen)
     (ensure-ilayout-var codegen super)
     (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)
     (funcall body (codegen-target codegen))
     (codegen-pop-function codegen (temporary-function)
                          (c-type (fun (lisp return-type)


@@ -499,11 +514,9 @@ (defun invoke-delegation-chain (codegen target basic-tail chain kernel)
    nil."
 
   (let* ((message (codegen-message codegen))
    nil."
 
   (let* ((message (codegen-message codegen))

-        (argument-tail (cond ((varargs-message-p message)
-                              (cons *sod-tmp-ap* basic-tail))
-                             ((keyword-message-p message)
-                              (cons (keyword-struct-pointer) basic-tail))
-                             (t basic-tail))))
+        (argument-tail (if (varargs-message-p message)
+                           (cons *sod-tmp-ap* basic-tail)
+                           basic-tail)))

     (labels ((next-trampoline (method chain)
               (if (or kernel chain)
                   (make-trampoline codegen (sod-method-class method)
     (labels ((next-trampoline (method chain)
               (if (or kernel chain)
                   (make-trampoline codegen (sod-method-class method)


@@ -514,9 +527,13 @@ (defun invoke-delegation-chain (codegen target basic-tail chain kernel)
               (if (null chain)
                   (funcall kernel target)
                   (let ((trampoline (next-trampoline (car chain)
               (if (null chain)
                   (funcall kernel target)
                   (let ((trampoline (next-trampoline (car chain)

-                                                     (cdr chain))))
+                                                     (cdr chain)))
+                        (tail (if (keyword-message-p message)
+                                  (cons (keyword-struct-pointer)
+                                        argument-tail)
+                                  argument-tail)))

                     (invoke-method codegen target
                     (invoke-method codegen target

-                                   (cons trampoline argument-tail)
+                                   (cons trampoline tail)

                                    (car chain))))))
       (invoke chain target))))
 
                                    (car chain))))))
       (invoke chain target))))