From dc84927c791873508f473f1d5679550882f86e91 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 16 Nov 2016 06:41:55 -0800
Subject: Completion of fallback list implementation.

* lib.c (find_symbol): New function.
(symbol_present): Search the fallback list also to
determine whether the symbol is visible.

* lib.h (find_symbol): Declared.

* parser.y (sym_helper): Implement a new behavior for
qualified symbols. Interning new symbols is only allowed
for packages that have an empty fallback list.

* parser.c (get_visible_syms): New static function.
(find_matching_syms): Use get_visible_syms to get
the list of eligible symbols. This way the fallback list
of the package is included if it is the current package.

* share/txr/stdlib/package.tl (defpackage): Do not insert
a default (:use usr) if there is no :usr clause. Since
defpackage is very new, no need for backward compatibility;
the amount of code depending on this is likely zero.

* txr.1: Documented fallback list feature.
---
 lib.c | 27 ++++++++++++++++++++++++++-
 1 file changed, 26 insertions(+), 1 deletion(-)

(limited to 'lib.c')

diff --git a/lib.c b/lib.c
index 233e3d3b..641b7337 100644
--- a/lib.c
+++ b/lib.c
@@ -5006,15 +5006,40 @@ static val symbol_present(val package, val sym)
 {
   type_check (package, PKG);
 
-  if (symbol_package(sym) == package)
+  if (sym->s.package == package)
     return t;
 
   if (gethash(package->pk.symhash, symbol_name(sym)) == sym)
     return t;
 
+  {
+    val fallback = get_hash_userdata(package->pk.symhash);
+
+    for (; fallback; fallback = cdr(fallback)) {
+      val fb_pkg = car(fallback);
+      if (gethash(fb_pkg->pk.symhash, symbol_name(sym)) == sym)
+        return t;
+    }
+  }
+
   return nil;
 }
 
+val find_symbol(val str, val package_in)
+{
+  val self = lit("find-symbol");
+  val package = get_package(self, package_in, nil);
+  val found, sym;
+
+  if (!stringp(str))
+    uw_throwf(error_s, lit("~s: name ~s isn't a string"), self, str, nao);
+
+  if ((sym = gethash_f(package->pk.symhash, str, mkcloc(found))) || found)
+    return sym;
+
+  return zero;
+}
+
 val intern(val str, val package_in)
 {
   val new_p;
-- 
cgit v1.2.3