compile-file: incremental expansion of top-level forms.

Harmonizing with the previous change to eval, the
compiler should also handle those situations.

* share/txr/stdlib/compiler.tl (compile-file): do not perform
a full expansion on each object that it reads from the file
before passing it into the top-level walk. Rather, the
raw form is passed into the top-level walk. It is partially
expanded with macro-expand, and this is repated at each
descent of the recursion. Only forms which are not top-level
forms are then fully expanded before compilation, by not
passing the t argument to compile-toplevel.

1 files changed, 18 insertions, 17 deletions

diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index 5b194263..34f29c03 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -1599,27 +1599,28 @@
                 ((starts-with "#!" line)))
           (put-line line out-stream)
           (seek-stream in-stream 0 :from-start))
-        (labels ((compile-form (form)
-                   (unless (atom form)
-                     (caseq (car form)
-                       (progn [mapdo compile-form (cdr form)])
-                       (compile-only (let ((*eval* nil))
-                                       [mapdo compile-form (cdr form)]))
-                       (eval-only (let ((*emit* nil))
-                                    [mapdo compile-form (cdr form)]))
-                       (t (when (and (or *eval* *emit*)
-                                     (not (constantp form)))
-                            (let* ((vm-desc (compile-toplevel form t))
-                                   (flat-vd (list-from-vm-desc vm-desc)))
-                              (when *eval*
-                                (sys:vm-execute-toplevel vm-desc))
-                              (when *emit*
-                                out.(add flat-vd)))))))))
+        (labels ((compile-form (unex-form)
+                   (let ((form (macroexpand unex-form)))
+                     (unless (atom form)
+                       (caseq (car form)
+                         (progn [mapdo compile-form (cdr form)])
+                         (compile-only (let ((*eval* nil))
+                                         [mapdo compile-form (cdr form)]))
+                         (eval-only (let ((*emit* nil))
+                                      [mapdo compile-form (cdr form)]))
+                         (t (when (and (or *eval* *emit*)
+                                       (not (constantp form)))
+                              (let* ((vm-desc (compile-toplevel form))
+                                     (flat-vd (list-from-vm-desc vm-desc)))
+                                (when *eval*
+                                  (sys:vm-execute-toplevel vm-desc))
+                                (when *emit*
+                                  out.(add flat-vd))))))))))
           (prinl %tlo-ver% out-stream)
           (unwind-protect
             (whilet ((obj (read in-stream *stderr* err-ret))
                      ((neq obj err-ret)))
-              (compile-form (sys:expand* obj)))
+              (compile-form obj))
             (let ((*print-circle* t)
                   (*package* (sys:make-anon-package)))
               (prinl out.(get) out-stream)