keyword arg errors throw to 'keyword-argument-error

* libguile/vm-engine.c (VM_NAME): Keyword arg errors are now thrown to
  'keyword-argument-error.

* libguile/vm.c: Define sym_keyword_argument_error, and statically
  allocate some other symbols.

* module/ice-9/optargs.scm (parse-lambda-case): Throw to
  'keyword-argument-error in kwarg error cases.

* module/ice-9/psyntax.scm (build-lambda-case): Remove a couple
  workarounds for the old memoizer. Throw to 'wrong-number-of-args if
  the lambda-case fails to parse.

* module/ice-9/psyntax-pp.scm: Regenerated.

* test-suite/tests/optargs.test: Update expected exceptions.

libguile/vm-engine.c

@@ -130,6 +130,8 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
   {
     SCM err_msg;
 
+    /* FIXME: need to sync regs before allocating anything, in each case. */
+
   vm_error_bad_instruction:
     err_msg  = scm_from_locale_string ("VM: Bad instruction: ~s");
     finish_args = scm_list_1 (scm_from_uchar (ip[-1]));
@@ -145,19 +147,24 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
     goto vm_error;
 
   vm_error_kwargs_length_not_even:
-    err_msg  = scm_from_locale_string ("Bad keyword argument list: odd length");
+    SYNC_ALL ();
-    finish_args = SCM_EOL;
+    err_msg = scm_from_locale_string ("Odd length of keyword argument list");
-    goto vm_error;
+    scm_error_scm (sym_keyword_argument_error, program, err_msg,
+                   SCM_EOL, SCM_BOOL_F);
 
   vm_error_kwargs_invalid_keyword:
-    err_msg  = scm_from_locale_string ("Bad keyword argument list: expected keyword");
+    /* FIXME say which one it was */
-    finish_args = SCM_EOL;
+    SYNC_ALL ();
-    goto vm_error;
+    err_msg = scm_from_locale_string ("Invalid keyword");
+    scm_error_scm (sym_keyword_argument_error, program, err_msg,
+                   SCM_EOL, SCM_BOOL_F);
 
   vm_error_kwargs_unrecognized_keyword:
-    err_msg  = scm_from_locale_string ("Bad keyword argument list: unrecognized keyword");
+    /* FIXME say which one it was */
-    finish_args = SCM_EOL;
+    SYNC_ALL ();
-    goto vm_error;
+    err_msg = scm_from_locale_string ("Unrecognized keyword");
+    scm_error_scm (sym_keyword_argument_error, program, err_msg,
+                   SCM_EOL, SCM_BOOL_F);
 
   vm_error_too_many_args:
     err_msg  = scm_from_locale_string ("VM: Too many arguments");

libguile/vm.c

@@ -169,9 +169,10 @@ vm_dispatch_hook (SCM vm, int hook_num)
  * VM Internal functions
  */
 
-static SCM sym_vm_run;
+SCM_SYMBOL (sym_vm_run, "vm-run");
-static SCM sym_vm_error;
+SCM_SYMBOL (sym_vm_error, "vm-error");
-static SCM sym_debug;
+SCM_SYMBOL (sym_keyword_argument_error, "keyword-argument-error");
+SCM_SYMBOL (sym_debug, "debug");
 
 static SCM
 really_make_boot_program (long nargs)
@@ -672,10 +673,6 @@ scm_bootstrap_vm (void)
                 scm_c_make_gsubr ("load-compiled/vm", 1, 0, 0,
                                   scm_load_compiled_with_vm));
 
-  sym_vm_run = scm_from_locale_symbol ("vm-run");
-  sym_vm_error = scm_from_locale_symbol ("vm-error");
-  sym_debug = scm_from_locale_symbol ("debug");
-
   scm_c_register_extension ("libguile", "scm_init_vm",
                             (scm_t_extension_init_func)scm_init_vm, NULL);
 

module/ice-9/optargs.scm

@@ -343,7 +343,8 @@
               (pair? (cdr args-tail))
               allow-other-keys?)
          (permissive-keys slots slots-tail (cddr args-tail) inits))
-        (else (error "unrecognized keyword" args-tail))))
+        (else (scm-error 'keyword-argument-error #f "Unrecognized keyword"
+                         '() args-tail))))
      (define (key slots slots-tail args-tail inits)
        (cond
         ((null? args-tail)
@@ -357,7 +358,8 @@
          (if rest-idx
              ;; no error checking, everything goes to the rest..
              (key slots slots-tail '() inits)
-             (error "bad keyword argument list" args-tail)))
+             (scm-error 'keyword-argument-error #f "Invalid keyword"
+                        '() args-tail)))
         ((and (keyword? (car args-tail))
               (pair? (cdr args-tail))
               (assq-ref kw-indices (car args-tail)))
@@ -368,7 +370,8 @@
               (pair? (cdr args-tail))
               allow-other-keys?)
          (key slots slots-tail (cddr args-tail) inits))
-        (else (error "unrecognized keyword" args-tail))))
+        (else (scm-error 'keyword-argument-error #f "Unrecognized keyword"
+                         '() args-tail))))
      (let ((args (list-copy args)))
        (req args #f args nreq)))
     (else (error "unexpected spec" spec))))

module/ice-9/psyntax.scm

@@ -518,14 +518,11 @@
                 '(,nreq ,nopt ,rest-idx ,nargs ,allow-other-keys? ,kw-indices)
                 (list ,@(map (lambda (i) `(lambda ,vars ,i)) inits))
                 %%args)
-               ;; FIXME: This _ is here to work around a bug in the
+               => (lambda (%%args) (apply (lambda ,vars ,body) %%args)))
-               ;; memoizer. The %%% makes it different from %%, also a
-               ;; memoizer workaround. See the "interesting bug" mail from
-               ;; 23 oct 2009. As soon as we change the evaluator, this
-               ;; can be removed.
-               => (lambda (%%%args . _) (apply (lambda ,vars ,body) %%%args)))
               ,@(or else-case
-                    `((%%args (error "wrong number of arguments" %%args)))))
+                    `((%%args (scm-error 'wrong-number-of-args #f
+                                         "Wrong number of arguments" '()
+                                         %%args)))))
             src))))))
 
   (define build-primref

test-suite/tests/optargs.test

@@ -23,18 +23,13 @@
   #:use-module (ice-9 optargs))
 
 (define exception:unrecognized-keyword
-  ;; Can be `vm-error' or `misc-error' depending on whether we use the
+  '(keyword-argument-error . "Unrecognized keyword"))
-  ;; interpreter or VM:
-  ;;  (vm-error vm-run "Bad keyword argument list: unrecognized keyword" ())
-  ;;  (misc-error #f "~A ~S" ("unrecognized keyword" (#:y 2)) #f)
-  (cons #t ".*"))
 
 (define exception:extraneous-arguments
-  ;; Can be `vm-error' or `misc-error' depending on whether we use the
+  ;; Message depends on whether we use the interpreter or VM, and on the
-  ;; interpreter or VM, and depending on the evenness of the number of extra
+  ;; evenness of the number of extra arguments (!).
-  ;; arguments (!).
+  ;'(keyword-argument-error . ".*")
-  (cons #t ".*"))
+  '(#t . ".*"))
-
 
 (define-syntax c&e
   (syntax-rules (pass-if pass-if-exception)