From 84b9d17a506658db9f5100820aad88342502e641 Mon Sep 17 00:00:00 2001 Message-Id: <84b9d17a506658db9f5100820aad88342502e641.1715314035.git.mdw@distorted.org.uk> From: Mark Wooding Date: Sun, 26 Mar 2017 15:16:18 +0100 Subject: [PATCH] src/{c-types-impl,method-{proto,impl}}.lisp: Improve `merge-keyword-lists'. Organization: Straylight/Edgeware From: Mark Wooding * Make the overall description of the merging site be a function (a) to report a file location and (b) to avoid formatting the thing if there isn't actually a problem. * Make the per-argument-list descriptions be functions so that they can report more than one message each. * Change `method-keyword-argument-lists' to report the inheritance path for methods involved in keyword argument conflicts. Add an argument to thread through an `inheritance-path-reporter-state' object to make this work. --- doc/SYMBOLS | 4 ++-- doc/clang.tex | 38 ++++++++++++++++++++++++------- doc/layout.tex | 3 ++- src/builtin.lisp | 25 +++++++++++++++----- src/c-types-impl.lisp | 53 ++++++++++++++++++++++++++++++------------- src/method-impl.lisp | 40 +++++++++++++++++++++++--------- src/method-proto.lisp | 12 +++++++--- 7 files changed, 128 insertions(+), 47 deletions(-) diff --git a/doc/SYMBOLS b/doc/SYMBOLS index 16e763a..89723e7 100644 --- a/doc/SYMBOLS +++ b/doc/SYMBOLS @@ -1303,8 +1303,8 @@ method-entry-function-type method-entry-slot-name method-entry method-keyword-argument-lists - effective-method t - sod::initialization-effective-method t + effective-method t t + sod::initialization-effective-method t t module-dependencies module (setf module-dependencies) diff --git a/doc/clang.tex b/doc/clang.tex index 18a8e1c..6d256ec 100644 --- a/doc/clang.tex +++ b/doc/clang.tex @@ -1017,13 +1017,15 @@ function type is the type of the function's return value. original list is not modified, but may share structure with the new list. \end{describe} -\begin{describe}{fun}{merge-keyword-lists @ @> @} +\begin{describe}{fun} + {merge-keyword-lists @ @ @> @} Merge a number of keyword-argument lists together and return the result. - The @ parameter is a list consisting of a number of @|(@ - . @)| pairs: in each pair, @ is either nil or an object whose - printed representation describes the origin of the corresponding @ - list suitable for inclusion in an error message, and @ is a list of + The @ is either nil or a function designator; see below. + + The @ parameter is a list consisting of a number of + @|(@ . @)| pairs: in each pair, @ + is either nil or a function designator, and @ is a list of \descref{argument}{cls} objects. The resulting list contains exactly one argument for each distinct argument @@ -1031,9 +1033,29 @@ function type is the type of the function's return value. default value from the earliest occurrence in the input @ of an argument with that name. - If the same name appears multiple times with different types, an error is - signalled quoting the name, conflicting types, and (if non-nil) the origins - of the offending argument objects. + If the same name appears multiple times with different types, a continuable + error will be signalled, and one of the conflicting argument types will be + chosen arbitrarily. The @ will be called to establish + information which will be reported to the user. It will be called with no + arguments and is expected to return two values: + \begin{itemize} + \item a file location @ or other object acceptable to + \descref{file-location}{gf}, to be used as the location of the main + error; and + \item an object @, whose printed representation should be a noun + phrase describing the object for which the argument lists are being + combined. + \end{itemize} + The phrasing of the error message is `type mismatch in @'. Either, + or both, of @ and @ may be nil, though this is considered poor + practice; if @ is nil, this is equivalent to a function + which returns two nil values. Following the error, the @s + for the @ lists containing the conflicting argument objects are + called, in an arbitrary order, with a single argument which is the + offending @|argument| object; the function is expected to issue information + messages (see \descref{info}{fun}) to give more detail for diagnosing the + conflict. If a @ is nil, then nothing happens; this is + considered poor practice. \end{describe} \begin{describe}{fun} diff --git a/doc/layout.tex b/doc/layout.tex index 80c264e..e42b83f 100644 --- a/doc/layout.tex +++ b/doc/layout.tex @@ -233,7 +233,8 @@ \end{describe} \begin{describe}{gf} - {method-keyword-argument-lists @ @ @> @} + {method-keyword-argument-lists @ @ @ + @> @} \end{describe} \begin{describe}{gf} diff --git a/src/builtin.lisp b/src/builtin.lisp index 77eca39..be9a8e5 100644 --- a/src/builtin.lisp +++ b/src/builtin.lisp @@ -295,15 +295,28 @@ (defmethod sod-message-effective-method-class 'initialization-effective-method) (defmethod method-keyword-argument-lists - ((method initialization-effective-method) direct-methods) + ((method initialization-effective-method) direct-methods state) (append (call-next-method) (mapcan (lambda (class) - (let ((initargs (sod-class-initargs class))) + (let* ((initargs (sod-class-initargs class)) + (map (make-hash-table)) + (arglist (mapcar + (lambda (initarg) + (let ((arg (sod-initarg-argument + initarg))) + (setf (gethash arg map) initarg) + arg)) + initargs))) (and initargs - (list (cons (format nil "initargs for ~A" - class) - (mapcar #'sod-initarg-argument - initargs)))))) + (list (cons (lambda (arg) + (info-with-location + (gethash arg map) + "Type `~A' from initarg ~ + in class `~A' (here)" + (argument-type arg) class) + (report-inheritance-path + state class)) + arglist))))) (sod-class-precedence-list (effective-method-class method))))) diff --git a/src/c-types-impl.lisp b/src/c-types-impl.lisp index e87964c..255a470 100644 --- a/src/c-types-impl.lisp +++ b/src/c-types-impl.lisp @@ -589,22 +589,38 @@ (defun fix-and-check-keyword-argument-list (list) list)) (export 'merge-keyword-lists) -(defun merge-keyword-lists (lists) +(defun merge-keyword-lists (whatfn lists) "Return the union of keyword argument lists. - The LISTS parameter consists of pairs (WHAT . ARGS), where WHAT is either - nil or a printable object describing the origin of this argument list - suitable for inclusion in an error message, and ARGS is a list of - `argument' objects. + The WHATFN is either nil or a designator for a function (see below). + + The LISTS parameter consists of pairs (REPORTFN . ARGS), where REPORTFN is + either nil or a designator for a function (see below); and and ARGS is a + list of `argument' objects. The resulting list contains exactly one argument for each distinct argument name appearing in the input lists; this argument will contain the default value corresponding to the name's earliest occurrence in the input LISTS. - If the same name appears in multiple input lists with different types, an - error is signalled; this error will quote the origins of a representative - conflicting pair of arguments." + If the same name appears in multiple input lists with different types, a + continuable error is signalled. + + The WHATFN function is given no arguments, and is expected to return a + file location (or other object convertible with `file-location'), and a + string (or other printable object) describing the site at which the + keyword argument lists are being merged or nil; a mismatch error will be + reported as being at the location returned by WHATFN, and the description + will be included in the error message. A nil WHATFN is equivalent to a + function which returns a nil location and description, though this is + considered poor practice. + + The REPORTFN is given a single argument ARG, which is one of the + conflicting `argument' objects found in the REPORTFN's corresponding + argument list: the REPORTFN is expected to issue additional `info' + messages to help the user diagnose the problem. The (common) name of the + argument has already been reported. A nil REPORTFN is equivalent to one + which does nothing, though this is considered poor practice." ;; The easy way through all of this is with a hash table mapping argument ;; names to (WHAT . ARG) pairs. @@ -614,23 +630,28 @@ (defun merge-keyword-lists (lists) ;; Set up the table. When we find a duplicate, check that the types ;; match. (dolist (item lists) - (let ((what (car item)) + (let ((reportfn (car item)) (args (cdr item))) (dolist (arg args) (let* ((name (argument-name arg)) (other-item (gethash name argmap))) (if (null other-item) - (setf (gethash name argmap) (cons what arg)) + (setf (gethash name argmap) (cons reportfn arg)) (let* ((type (argument-type arg)) - (other-what (car other-item)) + (other-reportfn (car other-item)) (other (cdr other-item)) (other-type (argument-type other))) (unless (c-type-equal-p type other-type) - (error "Type mismatch for keyword argument `~A': ~ - ~A~@[ (~A)~] doesn't match ~A~@[ (~A)~]" - name - type what - other-type other-what)))))))) + (multiple-value-bind (floc desc) + (if whatfn (funcall whatfn) (values nil nil)) + (cerror*-with-location floc + "Type mismatch for keyword ~ + argument `~A'~@[ in ~A~]" + name desc) + (when reportfn + (funcall reportfn arg)) + (when other-reportfn + (funcall other-reportfn other)))))))))) ;; Now it's just a matter of picking the arguments out again. (let ((result nil)) diff --git a/src/method-impl.lisp b/src/method-impl.lisp index 16ae56e..5ea09e3 100644 --- a/src/method-impl.lisp +++ b/src/method-impl.lisp @@ -250,17 +250,26 @@ (define-on-demand-slot delegating-direct-method function-type (method) ;;; Effective method classes. (defmethod method-keyword-argument-lists - ((method effective-method) direct-methods) + ((method effective-method) direct-methods state) (with-slots (message) method (and (keyword-message-p message) - (cons (cons (format nil "message ~A (at ~A)" - message (file-location 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 (format nil "method for ~A on ~A (at ~A)" - message - (sod-method-class m) - (file-location 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))))) @@ -268,11 +277,20 @@ (defmethod shared-initialize :after ((method effective-method) slot-names &key direct-methods) (declare (ignore slot-names)) - ;; Set the keyword argument list. - (with-slots (message keywords) method + ;; Set the keyword argument list. Blame the class as a whole for mismatch + ;; errors, because they're fundamentally a non-local problem about the + ;; class construction. + (with-slots ((class %class) message keywords) method (setf keywords - (merge-keyword-lists (method-keyword-argument-lists - method direct-methods))))) + (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)))))) (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 a986584..f7f1f47 100644 --- a/src/method-proto.lisp +++ b/src/method-proto.lisp @@ -64,13 +64,19 @@ (defgeneric primary-method-class (message) This protocol is used by `simple-message' subclasses.")) (export 'method-keyword-argument-lists) -(defgeneric method-keyword-argument-lists (method direct-methods) +(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 string describing the - source of the argument list, and a list of `argument' objects.")) + 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) -- [mdw]