diff options
| -rw-r--r-- | eval.c | 2 | ||||
| -rw-r--r-- | lib.c | 53 | ||||
| -rw-r--r-- | lib.h | 5 | ||||
| -rw-r--r-- | parser.y | 20 | ||||
| -rw-r--r-- | share/txr/stdlib/package.tl | 3 |
5 files changed, 72 insertions, 11 deletions
@@ -5246,6 +5246,8 @@ void eval_init(void) reg_fun(intern(lit("intern"), user_package), func_n2o(intern, 1)); reg_fun(intern(lit("unintern"), user_package), func_n2o(unintern, 1)); reg_fun(intern(lit("rehome-sym"), user_package), func_n2o(rehome_sym, 1)); + reg_fun(intern(lit("package-fallback-list"), user_package), func_n1(package_fallback_list)); + reg_fun(intern(lit("set-package-fallback-list"), user_package), func_n2(set_package_fallback_list)); reg_fun(intern(lit("symbolp"), user_package), func_n1(symbolp)); reg_fun(intern(lit("symbol-name"), user_package), func_n1(symbol_name)); reg_fun(intern(lit("symbol-package"), user_package), func_n1(symbol_package)); @@ -5089,6 +5089,59 @@ val rehome_sym(val sym, val package_in) return sym; } +val package_fallback_list(val package_in) +{ + val package = get_package(lit("package-fallback-list"), package_in, t); + return get_hash_userdata(package->pk.symhash); +} + +val set_package_fallback_list(val package_in, val list_in) +{ + val self = lit("set-package-fallback-list"); + val package = get_package(self, package_in, t); + val list = resolve_package_designators(self, list_in); + return set_hash_userdata(package->pk.symhash, list); +} + +val intern_fallback(val str, val package_in) +{ + 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("~s: name ~s isn't a string"), self, str, nao); + + if (fblist) { + val found; + val sym; + + if ((sym = gethash_f(package->pk.symhash, str, mkcloc(found))) || found) + return sym; + + for (; fblist; fblist = cdr(fblist)) { + val otherpkg = car(fblist); + if ((sym = gethash_f(otherpkg->pk.symhash, str, mkcloc(found))) || found) + return sym; + } + } + + { + val new_p; + loc place; + + place = gethash_l(package->pk.symhash, str, mkcloc(new_p)); + + if (!new_p) { + return deref(place); + } else { + val newsym = make_sym(str); + newsym->s.package = package; + return set(place, newsym); + } + } +} + val symbolp(val sym) { switch (type(sym)) { @@ -785,7 +785,6 @@ val package_alist(void); val package_name(val package); val package_symbols(val package); val package_local_symbols(val package); -val package_foreign_symbols(val package); val use_sym(val use_list, val package); val unuse_sym(val symbol, val package); val use_package(val use_list, val package); @@ -793,6 +792,10 @@ val unuse_package(val unuse_list, val package); val intern(val str, val package); val unintern(val sym, val package); val rehome_sym(val sym, val package); +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 symbolp(val sym); val symbol_name(val sym); val symbol_package(val sym); @@ -1249,7 +1249,7 @@ static val sym_helper(parser_t *parser, wchar_t *lexeme, val meta_allowed) int leading_at = *lexeme == L'@'; wchar_t *tokfree = lexeme; wchar_t *colon = wcschr(lexeme, L':'); - val sym_name = nil, pkg_name = nil, package = cur_package, sym; + val sym; if (leading_at) { if (!meta_allowed) { @@ -1264,32 +1264,32 @@ static val sym_helper(parser_t *parser, wchar_t *lexeme, val meta_allowed) *colon = 0; if (colon == lexeme) { - package = keyword_package_var; - sym_name = string(colon + 1); + val sym_name = string(colon + 1); scrub_scanner(parser->scanner, SYMTOK, tokfree); free(tokfree); + sym = intern(sym_name, keyword_package_var); } else if (colon != 0) { - pkg_name = string(lexeme); - sym_name = string(colon + 1); + val pkg_name = string(lexeme); + val sym_name = string(colon + 1); scrub_scanner(parser->scanner, SYMTOK, tokfree); free(tokfree); if (equal(pkg_name, lit("#"))) { - package = nil; + sym = make_sym(sym_name); } else { - package = find_package(pkg_name); + val package = find_package(pkg_name); if (!package) { yyerrorf(scnr, lit("~a:~a: package ~a not found"), pkg_name, sym_name, pkg_name, nao); return nil; } + sym = intern(sym_name, package); } } else { - sym_name = string(lexeme); + val sym_name = string(lexeme); scrub_scanner(parser->scanner, SYMTOK, tokfree); free(tokfree); + sym = intern_fallback(sym_name, cur_package); } - sym = package ? intern(sym_name, package) : make_sym(sym_name); - return leading_at ? rl(list(var_s, sym, nao), num(parser->lineno)) : sym; } diff --git a/share/txr/stdlib/package.tl b/share/txr/stdlib/package.tl index 7e62b6e5..12a8cf5e 100644 --- a/share/txr/stdlib/package.tl +++ b/share/txr/stdlib/package.tl @@ -68,6 +68,9 @@ (unless (eq (symbol-package s) ,pkg) (unuse-sym s ,pkg) (intern n ,pkg)))))) + (:fallback + (if rest ^((set-package-fallback-list ,pkg + ',rest)))) (:use-from (throwf 'eval-error "~s: :use-from clause needs package argument" |