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

[Erik Huelsmann]

Author: ehuelsmann
Date: Fri May 15 16:18:09 2009
New Revision: 11874

Log:
P2-FLET and P2-LABELS: Use COMPILE-PROGN-BODY instead of
reinventing the wheel.

Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Fri May 15 16:18:09 2009
@@ -4917,8 +4917,6 @@
 
 (defknown p2-flet (t t t) t)
 (defun p2-flet (form target representation)
-  ;; FIXME What if we're called with a non-NIL representation?
-  (declare (ignore representation))
   (let ((*local-functions* *local-functions*)
         (*visible-variables* *visible-variables*)
         (local-functions (cadr form))
@@ -4931,11 +4929,8 @@
         (when variable
           (push variable *visible-variables*))))
     (dolist (special (process-special-declarations body))
-      (push (make-variable :name special :special-p t)
-            *visible-variables*))
-    (do ((forms body (cdr forms)))
-        ((null forms))
-      (compile-form (car forms) (if (cdr forms) nil target) nil))))
+      (push (make-variable :name special :special-p t) *visible-variables*))
+    (compile-progn-body body target representation)))
 
 (defknown p2-labels (t t t) t)
 (defun p2-labels (form target representation)
@@ -4954,13 +4949,8 @@
     (dolist (local-function local-functions)
       (p2-labels-process-compiland local-function))
     (dolist (special (process-special-declarations body))
-      (push (make-variable :name special :special-p t)
-            *visible-variables*))
-    (do ((forms body (cdr forms)))
-        ((null forms))
-      (compile-form (car forms) (if (cdr forms) nil 'stack) nil))
-    (fix-boxing representation nil)
-    (emit-move-from-stack target representation)))
+      (push (make-variable :name special :special-p t) *visible-variables*))
+    (compile-progn-body body target representation)))
 
 (defun p2-lambda (compiland target)
   (let* ((lambda-list (cadr (compiland-lambda-expression compiland))))