;;; 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)
- (mapcar (lambda (m)
- (cons (c-function-keywords (sod-method-type m))
- (format nil "method for ~A on ~A (at ~A)"
- message
- (sod-method-class m)
- (file-location m))))
- direct-methods))))
+ (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 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