Changeset 11829 for trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

Timestamp:

05/04/09 19:43:30 (14 years ago)

Author:

ehuelsmann

Message:

Simplify p1-compiland and p2-compiland.
Create a new 'free-specials' field in the compiland
structure to share work done in p1 with p2.

File:

• trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

@@ -1021 +1021 @@
 
     (let* ((lambda-list (cadr form))
-           (body (cddr form)))
-
-      (let* ((closure (make-closure `(lambda ,lambda-list nil) nil))
-             (syms (sys::varlist closure))
-             (vars nil))
-        (dolist (sym syms)
-          (let ((var (make-variable :name sym
-                                    :special-p (special-variable-p sym))))
-            (push var vars)
-            (push var *all-variables*)))
-        (setf (compiland-arg-vars compiland) (nreverse vars))
-        (let ((*visible-variables* *visible-variables*))
-          (dolist (var (compiland-arg-vars compiland))
-            (push var *visible-variables*))
-          (let ((free-specials (process-declarations-for-vars body *visible-variables*)))
-            (dolist (var free-specials)
-              (push var *visible-variables*)))
-          (setf (compiland-p1-result compiland)
-                (list* 'LAMBDA lambda-list (p1-body body))))))))
+           (body (cddr form))
+           (*visible-variables* *visible-variables*)
+           (closure (make-closure `(lambda ,lambda-list nil) nil))
+           (syms (sys::varlist closure))
+           (vars nil))
+      (dolist (sym syms)
+        (let ((var (make-variable :name sym
+                                  :special-p (special-variable-p sym))))
+          (push var vars)
+          (push var *all-variables*)
+          (push var *visible-variables*)))
+      (setf (compiland-arg-vars compiland) (nreverse vars))
+      (let ((free-specials (process-declarations-for-vars body vars)))
+        (setf (compiland-free-specials compiland) free-specials)
+        (dolist (var free-specials)
+          (push var *visible-variables*)))
+      (setf (compiland-p1-result compiland)
+            (list* 'LAMBDA lambda-list (p1-body body))))))
 
 (provide "COMPILER-PASS1")