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

ehuelsmann at common-lisp.net ehuelsmann at common-lisp.net
Sun Aug 21 12:58:50 UTC 2011


Author: ehuelsmann
Date: Sun Aug 21 05:58:49 2011
New Revision: 13524

Log:
Reindenting to save left margin.

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

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp	Sun Aug 21 05:54:20 2011	(r13523)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp	Sun Aug 21 05:58:49 2011	(r13524)
@@ -1175,81 +1175,82 @@
 
 (defknown p1 (t) t)
 (defun p1 (form)
-  (cond ((symbolp form)
-         (let (value)
-           (cond
-             ((null form)
-              form)
-             ((eq form t)
-              form)
-             ((keywordp form)
-              form)
-             ((and (constantp form)
-                   (progn
-                     (setf value (symbol-value form))
-                     (or (numberp value)
-                         (stringp value)
-                         (pathnamep value))))
-              (setf form value))
-             (t
-              (let ((variable (find-visible-variable form)))
-                (when (null variable)
-                  (unless (or (special-variable-p form)
-                              (memq form *undefined-variables*))
-                    (compiler-style-warn
-                     "Undefined variable ~S assumed special" form)
-                    (push form *undefined-variables*))
-                  (setf variable (make-variable :name form :special-p t))
-                  (push variable *visible-variables*))
-                (let ((ref (make-var-ref variable)))
-                  (unless (variable-special-p variable)
-                    (when (variable-ignore-p variable)
-                      (compiler-style-warn
-                       "Variable ~S is read even though it was declared to be ignored."
-                       (variable-name variable)))
-                    (push ref (variable-references variable))
-                    (incf (variable-reads variable))
-                    (cond
-                      ((eq (variable-compiland variable) *current-compiland*)
-                       (dformat t "p1: read ~S~%" form))
-                      (t
-                       (dformat t "p1: non-local read ~S variable-compiland = ~S current compiland = ~S~%"
-                                form
-                                (compiland-name (variable-compiland variable))
-                                (compiland-name *current-compiland*))
-                       (setf (variable-used-non-locally-p variable) t))))
-                  (setf form ref)))
-              form))))
-        ((atom form)
-         form)
-        (t
-         (let ((op (%car form))
-               handler)
-           (cond
-             ((symbolp op)
-              (when (compiler-macro-function op)
-                (unless (notinline-p op)
-                  (multiple-value-bind (expansion expanded-p)
-                      (compiler-macroexpand form)
-                    ;; Fall through if no change...
-                    (when expanded-p
-                      (return-from p1 (p1 expansion))))))
-              (cond
-                ((setf handler (get op 'p1-handler))
-                 (funcall handler form))
-                ((macro-function op *compile-file-environment*)
-                 (p1 (macroexpand form *compile-file-environment*)))
-                ((special-operator-p op)
-                 (compiler-unsupported "P1: unsupported special operator ~S" op))
-                (t
-                 (p1-function-call form))))
-             ((and (consp op) (eq (%car op) 'LAMBDA))
-              (let ((maybe-optimized-call (rewrite-function-call form)))
-                (if (eq maybe-optimized-call form)
-                    (p1 `(%funcall (function ,op) ,@(cdr form)))
-                    (p1 maybe-optimized-call))))
-             (t
-              form))))))
+  (cond
+    ((symbolp form)
+     (let (value)
+       (cond
+         ((null form)
+          form)
+         ((eq form t)
+          form)
+         ((keywordp form)
+          form)
+         ((and (constantp form)
+               (progn
+                 (setf value (symbol-value form))
+                 (or (numberp value)
+                     (stringp value)
+                     (pathnamep value))))
+          (setf form value))
+         (t
+          (let ((variable (find-visible-variable form)))
+            (when (null variable)
+              (unless (or (special-variable-p form)
+                          (memq form *undefined-variables*))
+                (compiler-style-warn
+                 "Undefined variable ~S assumed special" form)
+                (push form *undefined-variables*))
+              (setf variable (make-variable :name form :special-p t))
+              (push variable *visible-variables*))
+            (let ((ref (make-var-ref variable)))
+              (unless (variable-special-p variable)
+                (when (variable-ignore-p variable)
+                  (compiler-style-warn
+                   "Variable ~S is read even though it was declared to be ignored."
+                   (variable-name variable)))
+                (push ref (variable-references variable))
+                (incf (variable-reads variable))
+                (cond
+                  ((eq (variable-compiland variable) *current-compiland*)
+                   (dformat t "p1: read ~S~%" form))
+                  (t
+                   (dformat t "p1: non-local read ~S variable-compiland = ~S current compiland = ~S~%"
+                            form
+                            (compiland-name (variable-compiland variable))
+                            (compiland-name *current-compiland*))
+                   (setf (variable-used-non-locally-p variable) t))))
+              (setf form ref)))
+          form))))
+    ((atom form)
+     form)
+    (t
+     (let ((op (%car form))
+           handler)
+       (cond
+         ((symbolp op)
+          (when (compiler-macro-function op)
+            (unless (notinline-p op)
+              (multiple-value-bind (expansion expanded-p)
+                  (compiler-macroexpand form)
+                ;; Fall through if no change...
+                (when expanded-p
+                  (return-from p1 (p1 expansion))))))
+          (cond
+            ((setf handler (get op 'p1-handler))
+             (funcall handler form))
+            ((macro-function op *compile-file-environment*)
+             (p1 (macroexpand form *compile-file-environment*)))
+            ((special-operator-p op)
+             (compiler-unsupported "P1: unsupported special operator ~S" op))
+            (t
+             (p1-function-call form))))
+         ((and (consp op) (eq (%car op) 'LAMBDA))
+          (let ((maybe-optimized-call (rewrite-function-call form)))
+            (if (eq maybe-optimized-call form)
+                (p1 `(%funcall (function ,op) ,@(cdr form)))
+                (p1 maybe-optimized-call))))
+         (t
+          form))))))
 
 (defun install-p1-handler (symbol handler)
   (setf (get symbol 'p1-handler) handler))




More information about the armedbear-cvs mailing list