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

[Erik Huelsmann]

Author: ehuelsmann
Date: Thu Dec 25 13:58:01 2008
New Revision: 11479

Log:
Fix compiled TAGBODY failures which were broken by the fixes to macro expansion.

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

Modified: trunk/abcl/src/org/armedbear/lisp/precompiler.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/precompiler.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/precompiler.lisp	Thu Dec 25 13:58:01 2008
@@ -959,7 +959,20 @@
       ((null body) (cons 'TAGBODY (nreverse result)))
     (if (atom (car body))
         (push (car body) result)
-        (push (precompile1 (car body)) result))))
+        (push (let* ((first-form (car body))
+                     (expanded (precompile1 first-form)))
+                (if (and (symbolp expanded)
+                         (neq expanded first-form))
+                    ;; Workaround:
+                    ;;  Since our expansion/compilation order
+                    ;;   is out of sync with the definition of
+                    ;;   TAGBODY (which requires the compiler
+                    ;;   to look for tags before expanding),
+                    ;;   we need to disguise anything which might
+                    ;;   look like a tag. We do this by wrapping
+                    ;;   it in a PROGN form.
+                    (list 'PROGN expanded)
+                    expanded)) result))))
 
 (defun precompile-eval-when (form)
   (list* 'EVAL-WHEN (cadr form) (mapcar #'precompile1 (cddr form))))