Print the faulty object upon invalid-keyword errors.

* libguile/vm.c (vm_error_kwargs_invalid_keyword,
  vm_error_kwargs_unrecognized_keyword): Add parameter.  Pass it
  enclosed in a list as the last argument to `scm_error_scm'.
* libguile/vm-i-system.c (bind_kwargs): Adjust accordingly.
* libguile/eval.c (error_invalid_keyword, error_unrecognized_keyword):
  Add parameter.
  (prepare_boot_closure_env_for_apply): Adjust accordingly.
* module/ice-9/eval.scm (primitive-eval): Likewise.
* libguile/error.c (scm_error_scm): Mention `keyword-argument-error' in
  docstring.
* module/ice-9/boot-9.scm (keyword-error-printer): New procedure; use it.
* test-suite/tests/optargs.test (c&e, with-test-prefix/c&e): Remove.
  ("define*")["unrecognized keyword"]: Test the value passed along the
  `keyword-argument-error' exception.
  ["invalid keyword"]: New test.
* doc/ref/api-control.texi (Error Reporting): Update `scm-error'
  description.

doc/ref/api-control.texi

@@ -1421,7 +1421,8 @@ Guile) formats using @code{display} and @code{~S} (was
 @code{system-error} then it should be a list containing the
 Unix @code{errno} value; If @var{key} is @code{signal} then it
 should be a list containing the Unix signal number; If
-@var{key} is @code{out-of-range} or @code{wrong-type-arg},
+@var{key} is @code{out-of-range}, @code{wrong-type-arg},
+or @code{keyword-argument-error},
 it is a list containing the bad value; otherwise
 it will usually be @code{#f}.
 @end deffn

libguile/error.c

@@ -80,7 +80,8 @@ SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0,
 	    "@code{system-error} then it should be a list containing the\n"
 	    "Unix @code{errno} value; If @var{key} is @code{signal} then it\n"
 	    "should be a list containing the Unix signal number; If\n"
-	    "@var{key} is @code{out-of-range} or @code{wrong-type-arg},\n"
+	    "@var{key} is @code{out-of-range}, @code{wrong-type-arg},\n"
+	    "or @code{keyword-argument-error}, "
             "it is a list containing the bad value; otherwise\n"
 	    "it will usually be @code{#f}.")
 #define FUNC_NAME s_scm_error_scm

libguile/eval.c

@@ -162,18 +162,18 @@ static void error_used_before_defined (void)
              "Variable used before given a value", SCM_EOL, SCM_BOOL_F);
 }
 
-static void error_invalid_keyword (SCM proc)
+static void error_invalid_keyword (SCM proc, SCM obj)
 {
   scm_error_scm (scm_from_latin1_symbol ("keyword-argument-error"), proc,
                  scm_from_locale_string ("Invalid keyword"), SCM_EOL,
-                 SCM_BOOL_F);
+                 scm_list_1 (obj));
 }
 
-static void error_unrecognized_keyword (SCM proc)
+static void error_unrecognized_keyword (SCM proc, SCM kw)
 {
   scm_error_scm (scm_from_latin1_symbol ("keyword-argument-error"), proc,
                  scm_from_locale_string ("Unrecognized keyword"), SCM_EOL,
-                 SCM_BOOL_F);
+                 scm_list_1 (kw));
 }
 
 
@@ -890,10 +890,10 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
                         break;
                       }
                   if (scm_is_null (walk) && scm_is_false (aok))
-                    error_unrecognized_keyword (proc);
+                    error_unrecognized_keyword (proc, k);
                 }
             if (scm_is_pair (args) && scm_is_false (rest))
-              error_invalid_keyword (proc);
+              error_invalid_keyword (proc, CAR (args));
 
             /* Now fill in unbound values, evaluating init expressions in their
                appropriate environment. */

libguile/vm-i-system.c

@@ -681,12 +681,12 @@ VM_DEFINE_INSTRUCTION (48, bind_kwargs, "bind-kwargs", 5, 0, 0)
 	    }
           VM_ASSERT (scm_is_pair (walk)
                      || (kw_and_rest_flags & F_ALLOW_OTHER_KEYS),
-                     vm_error_kwargs_unrecognized_keyword (program));
+                     vm_error_kwargs_unrecognized_keyword (program, sp[nkw]));
 	  nkw++;
 	}
       else
         VM_ASSERT (kw_and_rest_flags & F_REST,
-                   vm_error_kwargs_invalid_keyword (program));
+                   vm_error_kwargs_invalid_keyword (program, sp[nkw]));
     }
 
   NEXT;

libguile/vm.c

@@ -385,8 +385,8 @@ static void vm_error_not_a_variable (const char *func_name, SCM x) SCM_NORETURN;
 static void vm_error_not_a_thunk (const char *func_name, SCM x) SCM_NORETURN;
 static void vm_error_apply_to_non_list (SCM x) SCM_NORETURN;
 static void vm_error_kwargs_length_not_even (SCM proc) SCM_NORETURN;
-static void vm_error_kwargs_invalid_keyword (SCM proc) SCM_NORETURN;
+static void vm_error_kwargs_invalid_keyword (SCM proc, SCM obj) SCM_NORETURN;
-static void vm_error_kwargs_unrecognized_keyword (SCM proc) SCM_NORETURN;
+static void vm_error_kwargs_unrecognized_keyword (SCM proc, SCM kw) SCM_NORETURN;
 static void vm_error_too_many_args (int nargs) SCM_NORETURN;
 static void vm_error_wrong_num_args (SCM proc) SCM_NORETURN;
 static void vm_error_wrong_type_apply (SCM proc) SCM_NORETURN;
@@ -471,19 +471,19 @@ vm_error_kwargs_length_not_even (SCM proc)
 }
 
 static void
-vm_error_kwargs_invalid_keyword (SCM proc)
+vm_error_kwargs_invalid_keyword (SCM proc, SCM obj)
 {
   scm_error_scm (sym_keyword_argument_error, proc,
                  scm_from_latin1_string ("Invalid keyword"),
-                 SCM_EOL, SCM_BOOL_F);
+                 SCM_EOL, scm_list_1 (obj));
 }
 
 static void
-vm_error_kwargs_unrecognized_keyword (SCM proc)
+vm_error_kwargs_unrecognized_keyword (SCM proc, SCM kw)
 {
   scm_error_scm (sym_keyword_argument_error, proc,
                  scm_from_latin1_string ("Unrecognized keyword"),
-                 SCM_EOL, SCM_BOOL_F);
+                 SCM_EOL, scm_list_1 (kw));
 }
 
 static void

module/ice-9/boot-9.scm

@@ -944,12 +944,17 @@ procedures, their behavior is implementation dependent."
              (_ (default-printer)))
            args))
 
+  (define (keyword-error-printer port key args default-printer)
+    (let ((message (cadr args))
+          (faulty  (car (cadddr args)))) ; I won't do it again, I promise.
+      (format port "~a: ~s" message faulty)))
+
   (define (getaddrinfo-error-printer port key args default-printer)
     (format port "In procedure getaddrinfo: ~a" (gai-strerror (car args))))
 
   (set-exception-printer! 'goops-error scm-error-printer)
   (set-exception-printer! 'host-not-found scm-error-printer)
-  (set-exception-printer! 'keyword-argument-error scm-error-printer)
+  (set-exception-printer! 'keyword-argument-error keyword-error-printer)
   (set-exception-printer! 'misc-error scm-error-printer)
   (set-exception-printer! 'no-data scm-error-printer)
   (set-exception-printer! 'no-recovery scm-error-printer)

module/ice-9/eval.scm

@@ -351,7 +351,7 @@
                                          (scm-error
                                           'keyword-argument-error
                                           "eval" "Unrecognized keyword"
-                                          '() #f)))
+                                          '() (list (car args)))))
                                  (lp (cddr args)))
                                (if (pair? args)
                                    (if rest?
@@ -359,7 +359,7 @@
                                        (lp (cdr args))
                                        (scm-error 'keyword-argument-error
                                                   "eval" "Invalid keyword"
-                                                  '() #f))
+                                                  '() (list (car args))))
                                    ;; Finished parsing keywords. Fill in
                                    ;; uninitialized kwargs by evalling init
                                    ;; expressions in their appropriate

test-suite/tests/optargs.test

@@ -34,25 +34,6 @@
   ;'(keyword-argument-error . ".*")
   '(#t . ".*"))
 
-(define-syntax c&e
-  (syntax-rules (pass-if pass-if-exception)
-    ((_ (pass-if test-name exp))
-     (begin (pass-if (string-append test-name " (eval)")
-                     (primitive-eval 'exp))
-            (pass-if (string-append test-name " (compile)")
-                     (compile 'exp #:to 'value #:env (current-module)))))
-    ((_ (pass-if-exception test-name exc exp))
-     (begin (pass-if-exception (string-append test-name " (eval)")
-                               exc (primitive-eval 'exp))
-            (pass-if-exception (string-append test-name " (compile)")
-                               exc (compile 'exp #:to 'value
-                                            #:env (current-module)))))))
-
-(define-syntax with-test-prefix/c&e
-  (syntax-rules ()
-    ((_ section-name exp ...)
-     (with-test-prefix section-name (c&e exp) ...))))
-
 (with-test-prefix/c&e "optional argument processing"
   (pass-if "local defines work with optional arguments"
     (eval '(begin
@@ -165,10 +146,21 @@
     (let ((f (lambda* (#:key x) x)))
       (f 1 2 #:x 'x)))
 
-  (pass-if-exception "unrecognized keyword"
+  (pass-if-equal "unrecognized keyword" '(#:y)
-    exception:unrecognized-keyword
+    (catch 'keyword-argument-error
-    (let ((f (lambda* (#:key x) x)))
+      (lambda ()
-      (f #:y 'not-recognized)))
+        (let ((f (lambda* (#:key x) x)))
+          (f #:y 'not-recognized)))
+      (lambda (key proc fmt args data)
+        data)))
+
+  (pass-if-equal "invalid keyword" '(not-a-keyword)
+    (catch 'keyword-argument-error
+      (lambda ()
+        (let ((f (lambda* (#:key x) x)))
+          (f 'not-a-keyword 'something)))
+      (lambda (key proc fmt args data)
+        data)))
 
   (pass-if "rest given before keywords"
     ;; Passing the rest argument before the keyword arguments should not