src/method-{proto,impl}.lisp: Abstract out the receiver type.

[sod] / src / method-proto.lisp

diff --git a/src/method-proto.lisp b/src/method-proto.lisp
index 4a624c5..ed15ff2 100644 (file)
--- a/src/method-proto.lisp
+++ b/src/method-proto.lisp
@@ -49,6 +49,13 @@
    will be a list of applicable methods sorted in most-to-least specific
    order."))
 
    will be a list of applicable methods sorted in most-to-least specific
    order."))
 

+(export 'sod-message-receiver-type)
+(defgeneric sod-message-receiver-type (message class)
+  (:documentation
+   "Return the type of the `me' argument in a MESSAGE received by CLASS.
+
+   Typically this will just be `CLASS *'."))
+

 (export 'sod-message-applicable-methods)
 (defgeneric sod-message-applicable-methods (message class)
   (:documentation
 (export 'sod-message-applicable-methods)
 (defgeneric sod-message-applicable-methods (message class)
   (:documentation


@@ -57,6 +64,53 @@
    The list contains all methods applicable for MESSAGE when sent to an
    instance of CLASS, most specific first."))
 
    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
 (export 'sod-message-effective-method-class)
 (defgeneric sod-message-effective-method-class (message)
   (:documentation


@@ -71,21 +125,6 @@
 
    This protocol is used by `simple-message' subclasses."))
 
 
    This protocol is used by `simple-message' subclasses."))
 

-(export 'method-keyword-argument-lists)
-(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',
-   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)
   (:documentation
 (export 'compute-sod-effective-method)
 (defgeneric compute-sod-effective-method (message class)
   (:documentation


@@ -103,7 +142,8 @@
    The list needn't be in any particular order."))
 
 (export '(method-entry method-entry-effective-method
    The list needn't be in any particular order."))
 
 (export '(method-entry method-entry-effective-method

-         method-entry-chain-head method-entry-chain-tail))
+         method-entry-chain-head method-entry-chain-tail
+         method-entry-role))

 (defclass method-entry ()
   ((%method :initarg :method :type effective-method
            :reader method-entry-effective-method)
 (defclass method-entry ()
   ((%method :initarg :method :type effective-method
            :reader method-entry-effective-method)


@@ -231,6 +271,7 @@
 
    The default method indirects through `method-entry-slot-name-by-role'."))
 
 
    The default method indirects through `method-entry-slot-name-by-role'."))
 

+(export 'method-entry-slot-name-by-role)

 (defgeneric method-entry-slot-name-by-role (entry role name)
   (:documentation "Easier implementation for `method-entry-slot-name'.")
   (:method ((entry method-entry) (role (eql nil)) name) name)
 (defgeneric method-entry-slot-name-by-role (entry role name)
   (:documentation "Easier implementation for `method-entry-slot-name'.")
   (:method ((entry method-entry) (role (eql nil)) name) name)


@@ -254,9 +295,9 @@
   (:documentation
    "Returns true if the effective METHOD is live.
 
   (:documentation
    "Returns true if the effective METHOD is live.
 

-   An effective method is `live' if it should actually have proper method entry
-   functions associated with it and stored in the class vtable.  The other
-   possibility is that the method is `dead', in which case the function
+   An effective method is `live' if it should actually have proper method
+   entry functions associated with it and stored in the class vtable.  The
+   other possibility is that the method is `dead', in which case the function

    pointers in the vtable are left null."))
 
 ;;;--------------------------------------------------------------------------
    pointers in the vtable are left null."))
 
 ;;;--------------------------------------------------------------------------


@@ -304,13 +345,10 @@
 
 ;;; Additional instructions.
 
 
 ;;; Additional instructions.
 

-;; HACK: use gensyms for the `class' and `expr' slots to avoid leaking the
-;; slot names, because `expr' is exported by our package, and `class' is
-;; actually from the `common-lisp' package.

 (definst convert-to-ilayout (stream :export t)
 (definst convert-to-ilayout (stream :export t)

-    (#1=#:class chain-head #2=#:expr)
+    (%class chain-head %expr)

   (format stream "SOD_ILAYOUT(~@<~A, ~_~A, ~_~A~:>)"
   (format stream "SOD_ILAYOUT(~@<~A, ~_~A, ~_~A~:>)"

-         #1# (sod-class-nickname chain-head) #2#))
+         class (sod-class-nickname chain-head) expr))

 
 ;;; Utilities.
 
 
 ;;; Utilities.
 


@@ -447,11 +485,13 @@
                          ((keyword-message-p message)
                           (cons (make-argument *sod-key-pointer*
                                                (c-type (* (void :const))))
                          ((keyword-message-p message)
                           (cons (make-argument *sod-key-pointer*
                                                (c-type (* (void :const))))

-                                raw-args))))
+                                raw-args))
+                         (t raw-args)))

         (*keyword-struct-disposition* (if (effective-method-keywords method)
                                           :pointer :null)))
     (codegen-push codegen)
     (ensure-ilayout-var codegen super)
         (*keyword-struct-disposition* (if (effective-method-keywords method)
                                           :pointer :null)))
     (codegen-push codegen)
     (ensure-ilayout-var codegen super)

+    (deliver-call codegen :void "SOD__IGNORE" "sod__obj")

     (when (keyword-message-p message)
       (if (eq *keyword-struct-disposition* :null)
          (deliver-call codegen :void "SOD__IGNORE" *sod-key-pointer*)
     (when (keyword-message-p message)
       (if (eq *keyword-struct-disposition* :null)
          (deliver-call codegen :void "SOD__IGNORE" *sod-key-pointer*)