lib: streamline interning slightly.

We get rid of some defaulting and error checks from interning.
This saves a few cycles on startup in the large number of
intern calls that are performed.

* eval.c (eval_init): Wire the intern intrinsic to the new
intern_intrinsic function rather than intern.

* lib.c (intern): Remove package lookup and error check on str
argument.
(intern_intrinsic): New function, which has the package lookup
and error check.
(intern_fallback): Remove package lookup and error check.

* lib.h (intern_intrinsic): Declared.

* txr.c (txr_main): Fix one instance of an intern call that
relies on defaulting of the second argument, by passing
cur_package.

4 files changed, 17 insertions, 15 deletions

diff --git a/eval.c b/eval.c
index 1e9a5d76..7ac4c666 100644
--- a/eval.c
+++ b/eval.c
@@ -6625,7 +6625,7 @@ void eval_init(void)
   reg_fun(intern(lit("unuse-sym"), user_package), func_n2o(unuse_sym, 1));
   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, 1));
+  reg_fun(intern(lit("intern"), user_package), func_n2o(intern_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 e2683245..9d40f21c 100644
--- a/lib.c
+++ b/lib.c
@@ -5393,17 +5393,11 @@ val find_symbol_fb(val name, val package_in, val notfound_val_in)
   return default_null_arg(notfound_val_in);
 }
 
-val intern(val str, val package_in)
+val intern(val str, val package)
 {
   val self = lit("intern");
   val new_p;
-  loc place;
-  val package = get_package(self, package_in, t);
-
-  if (!stringp(str))
-    uw_throwf(error_s, lit("~a: name ~s isn't a string"), self, str, nao);
-
-  place = gethash_l(self, package->pk.symhash, str, mkcloc(new_p));
+  loc place = gethash_l(self, package->pk.symhash, str, mkcloc(new_p));
 
   if (!new_p) {
     return deref(place);
@@ -5414,6 +5408,17 @@ val intern(val str, val package_in)
   }
 }
 
+val intern_intrinsic(val str, val package_in)
+{
+  val self = lit("intern");
+  val package = get_package(self, package_in, t);
+
+  if (!stringp(str))
+    uw_throwf(error_s, lit("~a: name ~s isn't a string"), self, str, nao);
+
+  return intern(str, package);
+}
+
 val unintern(val symbol, val package_in)
 {
   val self = lit("unintern");
@@ -5492,15 +5497,11 @@ val set_package_fallback_list(val package_in, val list_in)
   return set_hash_userdata(package->pk.symhash, list);
 }
 
-val intern_fallback(val str, val package_in)
+val intern_fallback(val str, val package)
 {
   val self = lit("intern-fallback");
-  val package = get_package(self, package_in, nil);
   val fblist = get_hash_userdata(package->pk.symhash);
 
-  if (!stringp(str))
-    uw_throwf(error_s, lit("~a: name ~s isn't a string"), self, str, nao);
-
   if (fblist) {
     val found = gethash_e(self, package->pk.symhash, str);
 
diff --git a/lib.h b/lib.h
index c22e9890..f3969095 100644
--- a/lib.h
+++ b/lib.h
@@ -894,6 +894,7 @@ val symbol_needs_prefix(val self, val package, val sym);
 val find_symbol(val name, val package, val notfound_val);
 val find_symbol_fb(val name, val package, val notfound_val);
 val intern(val str, val package);
+val intern_intrinsic(val str, val package_in);
 val unintern(val sym, val package);
 val rehome_sym(val sym, val package);
 val package_foreign_symbols(val package);
diff --git a/txr.c b/txr.c
index be9ebc5c..3bb520ae 100644
--- a/txr.c
+++ b/txr.c
@@ -636,7 +636,7 @@ int txr_main(int argc, char **argv)
       val dopt_arg = sub(arg, two, t);
       cons_bind(var, def, split_str(dopt_arg, lit("=")));
       val deflist = if2(def, split_str(car(def), lit(",")));
-      val sym = intern(var, nil);
+      val sym = intern(var, cur_package);
 
       if (rest(deflist))
         bindings = cons(cons(sym, deflist), bindings);