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)
original list is not modified, but may share structure with the new list.
\end{describe}
-\begin{describe}{fun}{merge-keyword-lists @<lists> @> @<list>}
+\begin{describe}{fun}
+ {merge-keyword-lists @<what-function> @<lists> @> @<list>}
Merge a number of keyword-argument lists together and return the result.
- The @<lists> parameter is a list consisting of a number of @|(@<origin>
- . @<args>)| pairs: in each pair, @<origin> is either nil or an object whose
- printed representation describes the origin of the corresponding @<args>
- list suitable for inclusion in an error message, and @<args> is a list of
+ The @<what-function> is either nil or a function designator; see below.
+
+ The @<lists> parameter is a list consisting of a number of
+ @|(@<report-function> . @<args>)| pairs: in each pair, @<report-function>
+ is either nil or a function designator, and @<args> is a list of
\descref{argument}{cls} objects.
The resulting list contains exactly one argument for each distinct argument
default value from the earliest occurrence in the input @<lists> 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 @<what-function> 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 @<floc> or other object acceptable to
+ \descref{file-location}{gf}, to be used as the location of the main
+ error; and
+ \item an object @<what>, 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 @<what>'. Either,
+ or both, of @<floc> and @<what> may be nil, though this is considered poor
+ practice; if @<what-function> is nil, this is equivalent to a function
+ which returns two nil values. Following the error, the @<report-function>s
+ for the @<args> 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 @<report-function> is nil, then nothing happens; this is
+ considered poor practice.
\end{describe}
\begin{describe}{fun}
\end{describe}
\begin{describe}{gf}
- {method-keyword-argument-lists @<method> @<direct-methods> @> @<list>}
+ {method-keyword-argument-lists @<method> @<direct-methods> @<state>
+ @> @<list>}
\end{describe}
\begin{describe}{gf}
'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)))))
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.
;; 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))
;;; 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)))))
((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
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 / sod / commitdiff