X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/84b9d17a506658db9f5100820aad88342502e641..e895be217c3be6769708da17c9ae87cb22db040e:/src/method-proto.lisp diff --git a/src/method-proto.lisp b/src/method-proto.lisp index f7f1f47..e72044e 100644 --- a/src/method-proto.lisp +++ b/src/method-proto.lisp @@ -49,22 +49,24 @@ will be a list of applicable methods sorted in most-to-least specific order.")) -(export 'sod-message-effective-method-class) -(defgeneric sod-message-effective-method-class (message) +(export 'sod-message-receiver-type) +(defgeneric sod-message-receiver-type (message class) (:documentation - "Return the effective method class for the given MESSAGE. + "Return the type of the `me' argument in a MESSAGE received by CLASS. - This function is invoked by `compute-sod-effective-method'.")) + Typically this will just be `CLASS *' or `const CLASS *'.")) -(export 'primary-method-class) -(defgeneric primary-method-class (message) +(export 'sod-message-applicable-methods) +(defgeneric sod-message-applicable-methods (message class) (:documentation - "Return the name of the primary direct method class for MESSAGE. + "Return a list of applicable methods for a MESSAGE. - This protocol is used by `simple-message' subclasses.")) + The list contains all methods applicable for MESSAGE when sent to an + instance of CLASS, most specific first.")) -(export 'method-keyword-argument-lists) -(defgeneric method-keyword-argument-lists (method direct-methods state) +(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. @@ -73,10 +75,55 @@ 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.")) + 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 + "Return the effective method class for the given MESSAGE. + + This function is invoked by `compute-sod-effective-method'.")) + +(export 'primary-method-class) +(defgeneric primary-method-class (message) + (:documentation + "Return the name of the primary direct method class for MESSAGE. + + This protocol is used by `simple-message' subclasses.")) (export 'compute-sod-effective-method) (defgeneric compute-sod-effective-method (message class) @@ -95,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) @@ -223,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) @@ -246,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.")) ;;;-------------------------------------------------------------------------- @@ -296,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. @@ -439,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*)