From 1ec065092f42b4b0be3dcb833f3f5f24451701fd Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Mon, 9 Jul 2018 12:48:26 +0100 Subject: [PATCH] src/: Lift keyword-argument protocol from effective methods to messages. We're going to want to use this stuff during class finalization, before we've made the effective methods. This also refactors the machinery somewhat, introducing a new function `compute-effective-method-keyword-arguments' to do the slightly fiddly work in initializing `effective-method'. --- doc/SYMBOLS | 9 ++++---- doc/layout.tex | 16 ++++++++++---- src/builtin.lisp | 7 +++---- src/method-impl.lisp | 58 +++++++++++++++++++++++---------------------------- src/method-proto.lisp | 53 +++++++++++++++++++++++++++++++++------------- 5 files changed, 84 insertions(+), 59 deletions(-) diff --git a/doc/SYMBOLS b/doc/SYMBOLS index ff820f1..95604ae 100644 --- a/doc/SYMBOLS +++ b/doc/SYMBOLS @@ -512,6 +512,7 @@ method-proto.lisp codegen-method generic codegen-target generic compute-effective-method-body generic + compute-effective-method-keyword-arguments function compute-effective-methods generic compute-method-entry-functions generic compute-sod-effective-method generic @@ -541,12 +542,12 @@ method-proto.lisp method-entry-function-name generic method-entry-function-type generic method-entry-slot-name generic - method-keyword-argument-lists generic primary-method-class generic simple-method-body generic sod-message-applicable-methods generic sod-message-argument-tail generic sod-message-effective-method-class generic + sod-message-keyword-argument-lists generic sod-method-description generic sod-method-function-name generic sod-method-function-type generic @@ -1318,9 +1319,6 @@ method-entry-function-type method-entry method-entry-slot-name method-entry -method-keyword-argument-lists - effective-method t t - sod::initialization-effective-method t t module-dependencies module (setf module-dependencies) @@ -1530,6 +1528,9 @@ sod-message-effective-method-class sod::teardown-message sod-message-kernel-function aggregating-message +sod-message-keyword-argument-lists + sod::initialization-message sod-class t t + sod-message sod-class t t sod-message-method-class basic-message sod-class t simple-message sod-class t diff --git a/doc/layout.tex b/doc/layout.tex index 952cec0..ca31a9c 100644 --- a/doc/layout.tex +++ b/doc/layout.tex @@ -234,15 +234,23 @@ \end{describe} \begin{describe}{gf} - {sod-message-effective-method-class @ @> @} + {sod-message-keyword-argument-lists @ @ + @ @ + \nlret @} \end{describe} -\begin{describe}{gf}{primary-method-class @ @> @} +\begin{describe}{fun} + {compute-effective-method-keyword-arguments @ + @ + @ + \nlret @} \end{describe} \begin{describe}{gf} - {method-keyword-argument-lists @ @ @ - @> @} + {sod-message-effective-method-class @ @> @} +\end{describe} + +\begin{describe}{gf}{primary-method-class @ @> @} \end{describe} \begin{describe}{gf} diff --git a/src/builtin.lisp b/src/builtin.lisp index 5897da0..776d3a1 100644 --- a/src/builtin.lisp +++ b/src/builtin.lisp @@ -294,8 +294,8 @@ static const SodClass *const ~A__cpl[] = { ((message initialization-message)) 'initialization-effective-method) -(defmethod method-keyword-argument-lists - ((method initialization-effective-method) direct-methods state) +(defmethod sod-message-keyword-argument-lists + ((message initialization-message) (class sod-class) direct-methods state) (append (call-next-method) (mapcan (lambda (class) (let* ((initargs (sod-class-initargs class)) @@ -317,8 +317,7 @@ static const SodClass *const ~A__cpl[] = { (report-inheritance-path state class)) arglist))))) - (sod-class-precedence-list - (effective-method-class method))))) + (sod-class-precedence-list class)))) (defmethod lifecycle-method-kernel ((method initialization-effective-method) codegen target) diff --git a/src/method-impl.lisp b/src/method-impl.lisp index e93fb3a..91c22bb 100644 --- a/src/method-impl.lisp +++ b/src/method-impl.lisp @@ -249,29 +249,29 @@ ;;;-------------------------------------------------------------------------- ;;; Effective method classes. -(defmethod method-keyword-argument-lists - ((method effective-method) direct-methods state) - (with-slots (message) method - (and (keyword-message-p message) - (cons (cons (lambda (arg) - (let ((class (sod-message-class message))) - (info-with-location - message "Type `~A' declared in message ~ - definition in `~A' (here)" - (argument-type arg) class) - (report-inheritance-path state class))) - (c-function-keywords (sod-message-type message))) - (mapcar (lambda (m) - (cons (lambda (arg) - (let ((class (sod-method-class m))) - (info-with-location - m "Type `~A' declared in ~A direct ~ - method of `~A' (defined here)" - (argument-type arg) - (sod-method-description m) class) - (report-inheritance-path state class))) - (c-function-keywords (sod-method-type m)))) - direct-methods))))) +(defmethod sod-message-keyword-argument-lists + ((message sod-message) (class sod-class) direct-methods state) + (and (keyword-message-p message) + (cons (cons (lambda (arg) + (let ((class (sod-message-class message))) + (info-with-location + message "Type `~A' declared in message ~ + definition in `~A' (here)" + (argument-type arg) class) + (report-inheritance-path state class))) + (c-function-keywords (sod-message-type message))) + (mapcar (lambda (method) + (cons (lambda (arg) + (let ((class (sod-method-class method))) + (info-with-location + method "Type `~A' declared in ~A direct ~ + method of `~A' (defined here)" + (argument-type arg) + (sod-method-description method) class) + (report-inheritance-path state class))) + (c-function-keywords (sod-method-type method)))) + direct-methods)))) + (defmethod shared-initialize :after ((method effective-method) slot-names &key direct-methods) @@ -282,15 +282,9 @@ ;; class construction. (with-slots ((class %class) message keywords) method (setf keywords - (merge-keyword-lists - (lambda () - (values class - (format nil - "methods for message `~A' ~ - applicable to class `~A'" - message class))) - (method-keyword-argument-lists method direct-methods - (make-inheritance-path-reporter-state class)))))) + (compute-effective-method-keyword-arguments message + class + direct-methods)))) (export '(basic-effective-method effective-method-around-methods effective-method-before-methods diff --git a/src/method-proto.lisp b/src/method-proto.lisp index 4a624c5..1298431 100644 --- a/src/method-proto.lisp +++ b/src/method-proto.lisp @@ -57,6 +57,44 @@ 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-effective-method-class) (defgeneric sod-message-effective-method-class (message) (:documentation @@ -71,21 +109,6 @@ 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 -- 2.11.0