compiler: bugfix: handle defpackage and such properly.

The problem is that the file compiler is emitting one big form
that contains all of the compiled top-level forms. For obvious
reasons, this doesn't work when that form contains symbols
that are in a package which is defined by one of those forms;
the compiled file will not load due to qualified symbols
referencing a nonexistent package.

The solution is to break up that big form when it contains
forms that manipulate the package system in ways that
possibly affect the read time of subsequent forms.

* lib.c (delete_package): Use a non-destructive deletion on
the *package-alist*, because we are going to be referring
to this variable in the compiler to detect whether the list
of packages has changed.

* share/txr/stdlib/compiler.tl (%package-manip%): New global
variable. This is a list of functions that manipulate the
package system in suspicious ways.
(user:compile-file): When compiling a form which is a call to
any of the suspicious functions, add a :fence symbol into
the compiled form list. Also do this if the evaluation of the
compiled form modifies the *package-alist* variable.
When emitting the list of forms into the output file, remove
the :fence symbols and break it up into multiple lists
along these fence boundaries.

* txr.1: Documented the degenerate situation that can arise.

1 files changed, 19 insertions, 6 deletions

diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index 90eb2d41..51b0becd 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -1576,6 +1576,12 @@
 
 (defvarl %tlo-ver% ^(4 0 ,%big-endian%))
 
+(defvarl %package-manip% '(make-package delete-package
+                           use-package unuse-package
+                           set-package-fallback-list
+                           intern unintern rehome-sym
+                           use-sym unuse-sym))
+
 (defun open-compile-streams (in-path out-path)
   (let* ((rsuff (r$ %file-suff-rx% in-path))
          (suff (if rsuff [in-path rsuff]))
@@ -1649,19 +1655,26 @@
                          (t (when (and (or *eval* *emit*)
                                        (not (constantp form)))
                               (let* ((vm-desc (compile-toplevel form))
-                                     (flat-vd (list-from-vm-desc vm-desc)))
+                                     (flat-vd (list-from-vm-desc vm-desc))
+                                     (fence (member (car form) %package-manip%)))
                                 (when *eval*
-                                  (sys:vm-execute-toplevel vm-desc))
+                                  (let ((pa *package-alist*))
+                                    (sys:vm-execute-toplevel vm-desc)
+                                    (when (or (neq pa *package-alist*))
+                                      (set fence t))))
                                 (when *emit*
-                                  out.(add flat-vd))))))))))
+                                  out.(add flat-vd)
+                                  (when fence
+                                    out.(add :fence)))))))))))
           (prinl %tlo-ver% out-stream)
           (unwind-protect
             (whilet ((obj (read in-stream *stderr* err-ret))
                      ((neq obj err-ret)))
               (compile-form obj))
-            (let ((*print-circle* t)
-                  (*package* (sys:make-anon-package)))
-              (prinl out.(get) out-stream)
+            (let* ((*print-circle* t)
+                   (*package* (sys:make-anon-package))
+                   (out-forms (split* out.(get) (op where (op eq :fence)))))
+              [mapdo (op prinl @1 out-stream) out-forms]
               (delete-package *package*)))
 
           (let ((parser (sys:get-parser in-stream)))