From ae292b94e3bbbbb1d98b689028ab13a3fc64601e Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Tue, 20 Aug 2019 20:07:57 -0700 Subject: 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. --- eval.c | 2 +- lib.c | 27 ++++++++++++++------------- lib.h | 1 + txr.c | 2 +- 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); -- cgit v1.2.3