src/method-impl.lisp, etc.: Add a `readonly' message property.
[sod] / src / method-proto.lisp
index 2d5f471..e72044e 100644 (file)
    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 *' or `const CLASS *'."))
+
+(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
 
    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
    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)
 
    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)
   (: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."))
 
 ;;;--------------------------------------------------------------------------
 
 ;;; 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)
-    (#1=#:class chain-head #2=#:expr)
+    (%class chain-head %expr)
   (format stream "SOD_ILAYOUT(~@<~A, ~_~A, ~_~A~:>)"
-         #1# (sod-class-nickname chain-head) #2#))
+         class (sod-class-nickname chain-head) expr))
 
 ;;; Utilities.
 
                          ((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)
+    (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*)