X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/01778b39c53316dda3f757c49276d034039ee9cb..d5fdd49e70b734b791eb907706f92da5775e2a8b:/src/method-proto.lisp diff --git a/src/method-proto.lisp b/src/method-proto.lisp index a986584..ed15ff2 100644 --- a/src/method-proto.lisp +++ b/src/method-proto.lisp @@ -49,6 +49,68 @@ 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 + "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 +125,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 string describing the - source of the argument list, and a list of `argument' objects.")) - (export 'compute-sod-effective-method) (defgeneric compute-sod-effective-method (message class) (:documentation @@ -89,7 +142,8 @@ 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) @@ -217,6 +271,7 @@ 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) @@ -240,9 +295,9 @@ (: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.")) ;;;-------------------------------------------------------------------------- @@ -290,13 +345,10 @@ ;;; 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. @@ -433,11 +485,13 @@ ((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*)