Changeset 13523 for trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Timestamp:

08/21/11 12:54:20 (10 years ago)

Author:

ehuelsmann

Message:

Re #163: Don't macroexpand anything in compiler pass 2; we're completely
macroexpanded by precompilation and pass 1.

Also: Reindenting to save left margin.

File:

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

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

@@ -6882 +6882 @@
 (defknown compile-form (t t t) t)
 (defun compile-form (form target representation)
-  (cond ((consp form)
-         (let* ((op (%car form))
-                (handler (and (symbolp op) (get op 'p2-handler))))
-           (cond (handler
-                  (funcall handler form target representation))
-                 ((symbolp op)
-                  (cond ((macro-function op *compile-file-environment*)
-                         (compile-form (macroexpand form *compile-file-environment*)
-                                       target representation))
-                        ((special-operator-p op)
-                         (dformat t "form = ~S~%" form)
-                         (compiler-unsupported
-                          "COMPILE-FORM: unsupported special operator ~S" op))
-                        (t
-                         (compile-function-call form target representation))))
-                 ((and (consp op) (eq (%car op) 'LAMBDA))
-                  (aver (progn 'unexpected-lambda nil))
-                  (let ((new-form (list* 'FUNCALL form)))
-                    (compile-form new-form target representation)))
-                 (t
-                  (compiler-unsupported "COMPILE-FORM unhandled case ~S" form)))))
-        ((symbolp form)
-         (cond ((null form)
-                (emit-push-false representation)
-                (emit-move-from-stack target representation))
-               ((eq form t)
-                (emit-push-true representation)
-                (emit-move-from-stack target representation))
-               ((keywordp form)
-                (ecase representation
-                  (:boolean
-                   (emit 'iconst_1))
-                  ((nil)
-                   (emit-load-externalized-object form)))
-                (emit-move-from-stack target representation))
-               (t
-                ;; Shouldn't happen.
-                (aver nil))))
-        ((var-ref-p form)
-         (compile-var-ref form target representation))
-        ((node-p form)
-         (cond
-           ((jump-node-p form)
-            (let ((op (car (node-form form))))
-              (cond
-               ((eq op 'go)
-                (p2-go form target representation))
-               ((eq op 'return-from)
-                (p2-return-from form target representation))
-               (t
-                (assert (not "jump-node: can't happen"))))))
-           ((block-node-p form)
-            (p2-block-node form target representation))
-           ((let/let*-node-p form)
-            (p2-let/let*-node form target representation))
-           ((tagbody-node-p form)
-            (p2-tagbody-node form target)
-            (fix-boxing representation nil))
-           ((unwind-protect-node-p form)
-            (p2-unwind-protect-node form target)
-            (fix-boxing representation nil))
-           ((m-v-b-node-p form)
-            (p2-m-v-b-node form target)
-            (fix-boxing representation nil))
-           ((flet-node-p form)
-            (p2-flet-node form target representation))
-           ((labels-node-p form)
-            (p2-labels-node form target representation))
-           ((locally-node-p form)
-            (p2-locally-node form target representation))
-           ((catch-node-p form)
-            (p2-catch-node form target)
-            (fix-boxing representation nil))
-           ((progv-node-p form)
-            (p2-progv-node form target representation))
-           ((synchronized-node-p form)
-            (p2-threads-synchronized-on form target)
-            (fix-boxing representation nil))
-           (t
-            (aver (not "Can't happen")))
-))
-        ((constantp form)
-         (compile-constant form target representation))
-        (t
-         (compiler-unsupported "COMPILE-FORM unhandled case ~S" form)))
+  (cond
+    ((consp form)
+     (let* ((op (%car form))
+            (handler (and (symbolp op) (get op 'p2-handler))))
+       (cond
+         (handler
+          (funcall handler form target representation))
+         ((symbolp op)
+          (cond
+            ((special-operator-p op)
+             (dformat t "form = ~S~%" form)
+             (compiler-unsupported
+              "COMPILE-FORM: unsupported special operator ~S" op))
+            (t
+             (compile-function-call form target representation))))
+         ((and (consp op) (eq (%car op) 'LAMBDA))
+          (aver (progn 'unexpected-lambda nil))
+          (let ((new-form (list* 'FUNCALL form)))
+            (compile-form new-form target representation)))
+         (t
+          (compiler-unsupported "COMPILE-FORM unhandled case ~S" form)))))
+    ((symbolp form)
+     (cond
+       ((null form)
+        (emit-push-false representation)
+        (emit-move-from-stack target representation))
+       ((eq form t)
+        (emit-push-true representation)
+        (emit-move-from-stack target representation))
+       ((keywordp form)
+        (ecase representation
+          (:boolean
+           (emit 'iconst_1))
+          ((nil)
+           (emit-load-externalized-object form)))
+        (emit-move-from-stack target representation))
+       (t
+        ;; Shouldn't happen.
+        (aver nil))))
+    ((var-ref-p form)
+     (compile-var-ref form target representation))
+    ((node-p form)
+     (cond
+       ((jump-node-p form)
+        (let ((op (car (node-form form))))
+          (cond
+            ((eq op 'go)
+             (p2-go form target representation))
+            ((eq op 'return-from)
+             (p2-return-from form target representation))
+            (t
+             (assert (not "jump-node: can't happen"))))))
+       ((block-node-p form)
+        (p2-block-node form target representation))
+       ((let/let*-node-p form)
+        (p2-let/let*-node form target representation))
+       ((tagbody-node-p form)
+        (p2-tagbody-node form target)
+        (fix-boxing representation nil))
+       ((unwind-protect-node-p form)
+        (p2-unwind-protect-node form target)
+        (fix-boxing representation nil))
+       ((m-v-b-node-p form)
+        (p2-m-v-b-node form target)
+        (fix-boxing representation nil))
+       ((flet-node-p form)
+        (p2-flet-node form target representation))
+       ((labels-node-p form)
+        (p2-labels-node form target representation))
+       ((locally-node-p form)
+        (p2-locally-node form target representation))
+       ((catch-node-p form)
+        (p2-catch-node form target)
+        (fix-boxing representation nil))
+       ((progv-node-p form)
+        (p2-progv-node form target representation))
+       ((synchronized-node-p form)
+        (p2-threads-synchronized-on form target)
+        (fix-boxing representation nil))
+       (t
+        (aver (not "Can't happen")))))
+    ((constantp form)
+     (compile-constant form target representation))
+    (t
+     (compiler-unsupported "COMPILE-FORM unhandled case ~S" form)))
   t)