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

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Sat Sep 17 13:46:45 2011
New Revision: 13597

Log:
Fix issue reported by Eric Marsden: failure to compile functions
with defined source-transforms or compiler-macros, with calls specifying
keyword argument keywords as parameters.

Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-macro.lisp
   trunk/abcl/src/org/armedbear/lisp/source-transform.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-macro.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-macro.lisp	Sat Sep 17 13:36:41 2011	(r13596)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-macro.lisp	Sat Sep 17 13:46:45 2011	(r13597)
@@ -45,12 +45,21 @@
 
 (defmacro define-compiler-macro (name lambda-list &rest body)
   (let* ((form (gensym))
-         (env (gensym)))
+         (env (gensym))
+         (block-name (fdefinition-block-name name)))
     (multiple-value-bind (body decls)
-        (parse-defmacro lambda-list form body name 'defmacro :environment env)
+        (parse-defmacro lambda-list form body name 'defmacro :environment env
+                        ;; when we encounter an error
+                        ;; parsing the arguments in the call
+                        ;; (not in the difinition!), return
+                        ;; the arguments unmodified -- ie skip the
+                        ;; transform (see also source-transform.lisp)
+                        :error-fun `(lambda (&rest ignored)
+                                      (declare (ignore ignored))
+                                      (return-from ,block-name ,form)))
       (let ((expander `(lambda (,form ,env)
                          (declare (ignorable ,env))
-                         (block ,(fdefinition-block-name name) ,body))))
+                         (block ,block-name ,body))))
         `(progn
            (setf (compiler-macro-function ',name) (function ,expander))
            ',name)))))

Modified: trunk/abcl/src/org/armedbear/lisp/source-transform.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/source-transform.lisp	Sat Sep 17 13:36:41 2011	(r13596)
+++ trunk/abcl/src/org/armedbear/lisp/source-transform.lisp	Sat Sep 17 13:46:45 2011	(r13597)
@@ -44,12 +44,19 @@
 (defmacro define-source-transform (name lambda-list &rest body)
   (let* ((form (gensym))
          (env (gensym))
+         (block-name (if (symbolp name) name (cadr name)))
          (body (parse-defmacro lambda-list form body name 'defmacro
-                               :environment env))
+                               :environment env
+                               ;; when we encounter an error
+                               ;; parsing the arguments in the call
+                               ;; (not in the difinition!), return
+                               ;; the arguments unmodified -- ie skip the
+                               ;; transform (see also compiler-macro.lisp)
+                               :error-fun `(lambda (&rest ignored)
+                                             (declare (ignore ignored))
+                                             (return-from ,block-name ,form))))
          (expander
-          (if (symbolp name)
-              `(lambda (,form) (block ,name ,body))
-              `(lambda (,form) (block ,(cadr name) ,body)))))
+           `(lambda (,form) (block ,block-name ,body))))
     `(eval-when (:compile-toplevel :load-toplevel :execute)
        (setf (source-transform ',name) ,expander)
        ',name)))