From 34efdb8b2e45eb6543a8fbaadf8867ee58870677 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Thu, 5 Apr 2018 06:43:10 -0700
Subject: compile-file: handle gensyms and such.

* parser.c (read_file_common): The entire compiled
representation is now one big list. We must walk the list to
visit the individual compiled top-level forms.

* share/txr/stdlib/compiler.tl (compile-file): Collect all the
compiled top-level forms into one list, and emit it as one
object. This way, gensym references among the items will
resolve; for instance tests/012/man-or-boy.tl now compiles.
That file defines a function named by a gensym, and a macro
which expands to calls to that function. These end up in
separate top-level forms and have to resolve.
Because we are emitting everything as one big object, we
cannot rely on (in-package ...) forms influencing the reading
of the symbols. So we create a dummy package and switch to
that during the writing, which forces all symbols to be fully
qualified.
---
 parser.c                     | 17 ++++++++++-------
 share/txr/stdlib/compiler.tl | 19 +++++++++++++------
 2 files changed, 23 insertions(+), 13 deletions(-)

diff --git a/parser.c b/parser.c
index f39293ee..82576f43 100644
--- a/parser.c
+++ b/parser.c
@@ -632,13 +632,16 @@ static val read_file_common(val stream, val error_stream, val compiled)
                   stream, nao);
       first = nil;
     } else if (compiled) {
-      val nlevels = pop(&form);
-      val nregs = pop(&form);
-      val bytecode = pop(&form);
-      val datavec = pop(&form);
-      val funvec = car(form);
-      val desc = vm_make_desc(nlevels, nregs, bytecode, datavec, funvec);
-      (void) vm_execute_toplevel(desc);
+      for (; form; form = cdr(form)) {
+        val item = car(form);
+        val nlevels = pop(&item);
+        val nregs = pop(&item);
+        val bytecode = pop(&item);
+        val datavec = pop(&item);
+        val funvec = car(item);
+        val desc = vm_make_desc(nlevels, nregs, bytecode, datavec, funvec);
+        (void) vm_execute_toplevel(desc);
+      }
     } else {
       (void) eval_intrinsic(form, nil);
     }
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index a75b4571..39fc1340 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -1356,7 +1356,8 @@
         (*load-path* in-path)
         (sys:*load-recursive* t))
     (with-resources ((in-stream (car streams) (close-stream in-stream))
-                     (out-stream (cadr streams) (close-stream out-stream)))
+                     (out-stream (cadr streams) (close-stream out-stream))
+                     (out (new list-builder)))
       (labels ((compile-form (form)
                  (unless (atom form)
                    (caseq (car form)
@@ -1372,12 +1373,18 @@
                             (when *eval*
                               (sys:vm-execute-toplevel vm-desc))
                             (when *emit*
-                              (let ((*print-circle* t))
-                                (prinl flat-vd out-stream))))))))))
+                              out.(add flat-vd)))))))))
         (prinl '(0 0) out-stream)
-        (whilet ((obj (read in-stream *stderr* err-ret))
-                 ((neq obj err-ret)))
-          (compile-form (sys:expand* obj)))
+        (unwind-protect
+          (whilet ((obj (read in-stream *stderr* err-ret))
+                   ((neq obj err-ret)))
+            (compile-form (sys:expand* obj)))
+          (let ((*print-circle* t)
+                (*package* (make-package "$")))
+            (unwind-protect
+              (prinl out.(get) out-stream)
+              (delete-package *package*))))
+
         (let ((parser (sys:get-parser in-stream)))
           (when (> (sys:parser-errors parser) 0)
             (error "~s: compilation of ~s failed" 'compile-file
-- 
cgit v1.2.3