New function: intern-fb.

To accompany find-symbol-fb, there is intern-fb, which is like
intern, but searches the fallback list.

* eval.c (eval_init): Register intern-fb intrinsic.

* lib.c (intern_fallback_intrinsic): New function. Does
defaulting and error checks, then calls intern_fallback, just
like intern_intrinsic calls intern.

* lib.h (intern_fallback_intrinsic): Declared.

* txr.1: Documented.

4 files changed, 37 insertions, 2 deletions

diff --git a/eval.c b/eval.c
index 7ac4c666..b85e73d0 100644
--- a/eval.c
+++ b/eval.c
@@ -6626,6 +6626,7 @@ void eval_init(void)
   reg_fun(intern(lit("use-package"), user_package), func_n2o(use_package, 1));
   reg_fun(intern(lit("unuse-package"), user_package), func_n2o(unuse_package, 1));
   reg_fun(intern(lit("intern"), user_package), func_n2o(intern_intrinsic, 1));
+  reg_fun(intern(lit("intern-fb"), user_package), func_n2o(intern_fallback_intrinsic, 1));
   reg_fun(intern(lit("unintern"), user_package), func_n2o(unintern, 1));
   reg_fun(intern(lit("find-symbol"), user_package), func_n3o(find_symbol, 1));
   reg_fun(intern(lit("find-symbol-fb"), user_package), func_n3o(find_symbol_fb, 1));
diff --git a/lib.c b/lib.c
index 9d40f21c..d07a03ca 100644
--- a/lib.c
+++ b/lib.c
@@ -5532,6 +5532,17 @@ val intern_fallback(val str, val package)
   }
 }
 
+val intern_fallback_intrinsic(val str, val package_in)
+{
+  val self = lit("intern-fallback");
+  val package = get_package(self, package_in, nil);
+
+  if (!stringp(str))
+    uw_throwf(error_s, lit("~a: name ~s isn't a string"), self, str, nao);
+
+  return intern_fallback(str, package);
+}
+
 val symbolp(val sym)
 {
   switch (type(sym)) {
diff --git a/lib.h b/lib.h
index f3969095..34b10123 100644
--- a/lib.h
+++ b/lib.h
@@ -901,6 +901,7 @@ val package_foreign_symbols(val package);
 val package_fallback_list(val package);
 val set_package_fallback_list(val package, val list);
 val intern_fallback(val str, val package);
+val intern_fallback_intrinsic(val str, val package_in);
 val symbolp(val sym);
 val symbol_name(val sym);
 val symbol_package(val sym);
diff --git a/txr.1 b/txr.1
index a1234c92..93c02ab2 100644
--- a/txr.1
+++ b/txr.1
@@ -50364,7 +50364,10 @@ clause of the
 .code defpackage
 macro.  The fallback package list plays a role only in three situations:
 one in the \*(TL parser, one in the printer, and one in the interactive
-listener.
+listener. Besides that, two library functions refer to it:
+.code intern-fb
+and
+.codn find-symbol-fb .
 
 The parser situation involving the fallback list occurs when the
 \*(TL parser resolves an unqualified symbol token: a symbol token not carrying
@@ -51004,7 +51007,7 @@ package objects. Strings are taken to be package names, which must
 resolve to existing packages. Symbols are reduced to strings via
 .codn symbol-name .
 
-.coNP Function @ intern
+.coNP Functions @ intern and @ intern-fb
 .synb
 .mets (intern < name <> [ package ])
 .syne
@@ -51033,6 +51036,25 @@ is created and inserted into
 and that symbol is returned. In this case, the package becomes the
 symbol's home package.
 
+The
+.code intern-fb
+function is very similar to
+.code intern
+except that if the symbol is not found in
+.meta package
+then the packages listed in the fallback list of
+.meta package
+are searched, in order. Only these packages themselves are searched,
+not their own fallback lists. If a symbol called
+.meta name
+is found, the search terminates and that symbol is returned.
+Only if nothing is found in the fallback list will
+.code intern-fb
+create a new symbol and insert it into
+.metn package ,
+exactly like
+.codn intern .
+
 .coNP Function @ unintern
 .synb
 .mets (unintern < symbol <> [ package ])