New function: merge-delete-package.

This is a useful function which supports the use of temporary
packages over the scope of file compilation units.
A file can be read under a temporary package which provides
usefully customized symbol visibility consisting of
an arrangement of symbols from various other packages.
Then, in a single operation, thanks to this new function,
that packag can be deleted and all of its local symbols
(those having been newly interned over the course of the
file) are transferred to some other, more permanent package.

* eval.c (eval_init): merge-delete-package intrinsic
registered.

* lib.c (merge_delete_package): New function.

* lib.h (merge_delete_package): Declared.

* txr.1: Documented.

4 files changed, 44 insertions, 0 deletions

diff --git a/eval.c b/eval.c
index 40e97ce9..000a541b 100644
--- a/eval.c
+++ b/eval.c
@@ -6670,6 +6670,7 @@ void eval_init(void)
   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("merge-delete-package"), user_package), func_n2o(merge_delete_package, 1));
   reg_fun(intern(lit("package-alist"), user_package), func_n0(package_alist));
   reg_fun(intern(lit("package-name"), user_package), func_n1(package_name));
   reg_fun(intern(lit("package-symbols"), user_package), func_n1(package_symbols));
diff --git a/lib.c b/lib.c
index d5e8fec4..f54a71c4 100644
--- a/lib.c
+++ b/lib.c
@@ -5177,6 +5177,25 @@ val delete_package(val package_in)
   return nil;
 }
 
+val merge_delete_package(val to_in, val victim_in)
+{
+  val self = lit("merge-delete-package");
+  val to = get_package(self, to_in, nil);
+  val victim = get_package(self, victim_in, t);
+  struct hash_iter hi;
+  val cell;
+
+  us_hash_iter_init(&hi, victim->pk.symhash);
+
+  while ((cell = hash_iter_next(&hi))) {
+    val sym = us_cdr(cell);
+    if (symbol_package(sym) == victim)
+      rehome_sym(sym, to);
+  }
+
+  return delete_package(victim);
+}
+
 val package_alist(void)
 {
   return deref(cur_package_alist_loc);
diff --git a/lib.h b/lib.h
index 5be2c037..d54ac735 100644
--- a/lib.h
+++ b/lib.h
@@ -899,6 +899,7 @@ val make_anon_package(void);
 val packagep(val obj);
 val find_package(val name);
 val delete_package(val package);
+val merge_delete_package(val to, val victim);
 val package_alist(void);
 val package_name(val package);
 val package_symbols(val package);
diff --git a/txr.1 b/txr.1
index a97e3246..f8a4d0f1 100644
--- a/txr.1
+++ b/txr.1
@@ -52801,6 +52801,29 @@ are scrubbed of any foreign symbols which are the local symbols
 of the deleted
 .metn package .
 
+.coNP Function @ merge-delete-package
+.synb
+.mets (merge-delete-package dst-package <> [ src-package ])
+.syne
+.desc
+The
+.code merge-delete-package
+iterates over all of the local symbols of
+.meta src-package
+and rehomes each symbol into
+.metn dst-package .
+Then, it deletes
+.metn src-package .
+
+Note: the local symbols are identified as if using
+.codn package-local-symbols ,
+rehoming is performed as if using
+.codn rehome-sym ,
+and deleting
+.meta src-package
+is performed as if using
+.codn delete-package .
+
 .coNP Function @ packagep
 .synb
 .mets (packagep << obj )