[armedbear-cvs] r13596 - trunk/abcl/src/org/armedbear/lisp

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Sat Sep 17 13:36:41 2011
New Revision: 13596

Log:
When an error function is passed into PARSE-DEFMACRO-LAMBDA-LIST,
call it (at run time) instead of always calling ERROR. (To be used
in my next commit.)

Modified:
   trunk/abcl/src/org/armedbear/lisp/destructuring-bind.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/destructuring-bind.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/destructuring-bind.lisp	Sat Sep 17 13:05:11 2011	(r13595)
+++ trunk/abcl/src/org/armedbear/lisp/destructuring-bind.lisp	Sat Sep 17 13:36:41 2011	(r13596)
@@ -304,14 +304,16 @@
           (push `(multiple-value-bind (,problem ,info)
                      (verify-keywords ,rest-name ',keys ',allow-other-keys-p)
                    (when ,problem
-;;                   (,error-fun
-;;                    'defmacro-lambda-list-broken-key-list-error
-;;                    :kind ',error-kind
-;;                    ,@(when name `(:name ',name))
-;;                    :problem ,problem
-;;                    :info ,info)
-                     (error 'program-error "Unrecognized keyword argument ~S" (car ,info)))
-                     )
+                     ,(if (eq error-fun 'error)
+                          `(error 'program-error
+                                  "Unrecognized keyword argument ~S"
+                                  (car ,info))
+                          `(,error-fun
+                           'defmacro-lambda-list-broken-key-list-error
+                           :kind ',error-kind
+                           ,@(when name `(:name ',name))
+                           :problem ,problem
+                           :info ,info))))
                 *arg-tests*)))
     (values env-arg-used minimum (if (null restp) maximum nil))))