src/module-parse.lisp: Improve error recovery for `lisp' items.

[sod] / src / c-types-impl.lisp

diff --git a/src/c-types-impl.lisp b/src/c-types-impl.lisp
index e87964c66a09f924b3e0ad9922f5a1514dac12ec..255a470227f7629487e4b7e3077cdd2abc93ec71 100644 (file)
--- 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))