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

[Erik Huelsmann]

Author: ehuelsmann
Date: Fri Apr  3 15:41:28 2009
New Revision: 11723

Log:
Fix [interpreted mode] RESTART-CASE.{29,30,31}.

When expanding macros inside a macro, use the current expansion environment to make sure
all local macro definitions get expanded too.

Modified:
   trunk/abcl/src/org/armedbear/lisp/restart.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/restart.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/restart.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/restart.lisp	Fri Apr  3 15:41:28 2009
@@ -163,8 +163,8 @@
 ;; ERROR, CERROR, or WARN (or is a macro form which macroexpands into such a
 ;; list), then WITH-CONDITION-RESTARTS is used implicitly to associate the
 ;; indicated restarts with the condition to be signaled."
-(defun munge-restart-case-expression (expression)
-  (let ((exp (macroexpand expression)))
+(defun munge-restart-case-expression (expression env)
+  (let ((exp (macroexpand expression env)))
     (if (consp exp)
 	(let* ((name (car exp))
 	       (args (if (eq name 'cerror) (cddr exp) (cdr exp))))
@@ -186,7 +186,7 @@
               expression))
         expression)))
 
-(defmacro restart-case (expression &body clauses)
+(defmacro restart-case (expression &body clauses &environment env)
   (let ((block-tag (gensym))
         (temp-var (gensym))
         (data
@@ -215,7 +215,8 @@
                                          (go ,tag))
                                       , at keys)))
                          data)
-                (return-from ,block-tag ,(munge-restart-case-expression expression)))
+                (return-from ,block-tag
+                  ,(munge-restart-case-expression expression env)))
                ,@(mapcan #'(lambda (datum)
                             (let ((tag  (nth 1 datum))
                                   (bvl  (nth 3 datum))