[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