compiler: replace "$" package hack.

When compile-file writes emits the file, it does so with
*package* bound to a temporary package named "$" so that all
the symbols get fully qualified. Problem is, this is a valid
package name and is added to the package list.  While the
package exists, symbols such as $:a could be interned. If such
symbols occur in code being compiled, they get emitted using
unqualified names.  Let's introduce an internal interface for
making an anonymous package which isn't on the list of
package, and which has a name that results in bad syntax if it
occurs in print.

* eval.c (eval_init): Register sys:make-anon-package
intrinsic.

* lib.c (make_package_common): New static function.
(make_package): Package construction and initialization
code moved into make_package_common.
(make_anon_package): New function.

* lib.h (make_anon_package): Declared.

* share/txr/stdlib/compiler.tl (usr:compile-file): When
writing out translation, bind *package* to anonymous
package from sys:make-anon-package.

4 files changed, 23 insertions, 12 deletions

diff --git a/eval.c b/eval.c
index a34301ab..e38770d3 100644
--- a/eval.c
+++ b/eval.c
@@ -6580,6 +6580,7 @@ void eval_init(void)
   reg_var(package_s = intern(lit("*package*"), user_package),
           (opt_compat && opt_compat <= 190) ? user_package : public_package);
   reg_fun(intern(lit("make-package"), user_package), func_n1(make_package));
+  reg_fun(intern(lit("make-anon-package"), system_package), func_n0(make_anon_package));
   reg_fun(intern(lit("find-package"), user_package), func_n1(find_package));
   reg_fun(intern(lit("delete-package"), user_package), func_n1(delete_package));
   reg_fun(intern(lit("package-alist"), user_package), func_n0(package_alist));
diff --git a/lib.c b/lib.c
index ad209037..ad9e04f1 100644
--- a/lib.c
+++ b/lib.c
@@ -5145,6 +5145,18 @@ val gensym(val prefix)
   return make_sym(name);
 }
 
+static val make_package_common(val name)
+{
+  val obj = make_obj();
+  obj->pk.type = PKG;
+  obj->pk.name = name;
+  obj->pk.symhash = nil; /* make_hash calls below could trigger gc! */
+  obj->pk.hidhash = nil;
+  obj->pk.symhash = make_hash(nil, nil, lit("t")); /* don't have t yet! */
+  obj->pk.hidhash = make_hash(nil, nil, lit("t"));
+  return obj;
+}
+
 val make_package(val name)
 {
   if (find_package(name)) {
@@ -5155,19 +5167,17 @@ val make_package(val name)
     uw_throwf(error_s, lit("make-package: package name can't be empty string"),
               nao);
   } else {
-    val obj = make_obj();
-    obj->pk.type = PKG;
-    obj->pk.name = name;
-    obj->pk.symhash = nil; /* make_hash calls below could trigger gc! */
-    obj->pk.hidhash = nil;
-    obj->pk.symhash = make_hash(nil, nil, lit("t")); /* don't have t yet! */
-    obj->pk.hidhash = make_hash(nil, nil, lit("t"));
-
+    val obj = make_package_common(name);
     mpush(cons(name, obj), cur_package_alist_loc);
     return obj;
   }
 }
 
+val make_anon_package(void)
+{
+  return make_package_common(lit("#<anon-package>"));
+}
+
 val packagep(val obj)
 {
   return type(obj) == PKG ? t : nil;
diff --git a/lib.h b/lib.h
index 4866893d..fc70d47c 100644
--- a/lib.h
+++ b/lib.h
@@ -830,6 +830,7 @@ val break_str(val str, val set);
 val make_sym(val name);
 val gensym(val prefix);
 val make_package(val name);
+val make_anon_package(void);
 val packagep(val obj);
 val find_package(val name);
 val delete_package(val package);
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index ea9b932d..572cb396 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -1559,10 +1559,9 @@
                      ((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*))))
+                  (*package* (sys:make-anon-package)))
+              (prinl out.(get) out-stream)
+              (delete-package *package*)))
 
           (let ((parser (sys:get-parser in-stream)))
             (when (> (sys:parser-errors parser) 0)