From 847a7b6c5292bd2126303e3ab7a6916657e13a71 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Tue, 8 Nov 2016 21:09:45 -0800 Subject: Implement *package* special var; package overhaul. * eval.c (load): Rebind *package* in the local dynamic environment already established for the sake of *load-path*. By doing this we cause *package* to be restored to its prior value, which allows the loaded file to alter it. Common Lisp works this way. (eval_init): Register *package* variable, with the user package as its default value. * lib.c (package_s): New symbol variable. (intern, rehome_sym): Default the package argument to the current package, not to user_package. (get_user_package, get_system_package, get_keyword_package): Functions removed. (get_current_package): New function. (obj_print_impl): Revise symbol printing. Keyword and uninterned symbols are printed with : and #: prefixes. The remainder are printed with a package prefix if their home package isn't the current package. * lib.h (keyword_package, user_package, system_package): These macros are just straight aliases for the global variables, not going through the lookup mechanism, which was pointless. (cur_package): New macro. (package_s): Declared. (get_current_package): Declared. * lisplib.c (lisplib_try_load): Establish a local dynamic environment, and bind the *package* variable to the user package which the library modules expect. * parser.c (find_matching_syms, provide_completions): Treat unqualified symbols in the current package rather than user package. * parser.y (sym_helper): Intern unqualified symbols in the current package, not user package. * txr.1: Document that the variables user-package, system-package and keyword-package should not be modified. Document the *package* special variable, and that intern and rehome-sym default their package argument to its value. (Here we get rid of wrong references to the undocumented variable *user-package*). --- eval.c | 2 ++ lib.c | 37 +++++++++++-------------------------- lib.h | 13 ++++++------- lisplib.c | 19 ++++++++++++++----- parser.c | 4 ++-- parser.y | 2 +- txr.1 | 23 +++++++++++++++++++++-- 7 files changed, 57 insertions(+), 43 deletions(-) diff --git a/eval.c b/eval.c index c3392acd..e649af91 100644 --- a/eval.c +++ b/eval.c @@ -3398,6 +3398,7 @@ val load(val target) dyn_env = make_env(nil, nil, dyn_env); env_vbind(dyn_env, load_path_s, path); + env_vbind(dyn_env, package_s, cur_package); if (!read_eval_stream(stream, std_error, nil)) { close_stream(stream, nil); @@ -5203,6 +5204,7 @@ void eval_init(void) reg_fun(intern(lit("make-sym"), user_package), func_n1(make_sym)); reg_fun(intern(lit("gensym"), user_package), func_n1o(gensym, 0)); reg_var(gensym_counter_s = intern(lit("*gensym-counter*"), user_package), zero); + reg_var(package_s = intern(lit("*package*"), user_package), user_package_var); reg_fun(intern(lit("make-package"), user_package), func_n1(make_package)); reg_fun(intern(lit("find-package"), user_package), func_n1(find_package)); reg_fun(intern(lit("delete-package"), user_package), func_n1(delete_package)); diff --git a/lib.c b/lib.c index 8f1ca8c4..21901c7f 100644 --- a/lib.c +++ b/lib.c @@ -79,7 +79,7 @@ int async_sig_enabled = 0; val packages; val system_package_var, keyword_package_var, user_package_var; -val system_package_s, keyword_package_s, user_package_s; +val package_s, system_package_s, keyword_package_s, user_package_s; val null_s, t, cons_s, str_s, chr_s, fixnum_s, sym_s, pkg_s, fun_s, vec_s; val lit_s, stream_s, hash_s, hash_iter_s, lcons_s, lstr_s, cobj_s, cptr_s; @@ -4832,7 +4832,7 @@ val intern(val str, val package) loc place; if (null_or_missing_p(package)) { - package = user_package; + package = cur_package; } else if (stringp(package)) { val p = find_package(package); if (!p) @@ -4859,7 +4859,7 @@ val rehome_sym(val sym, val package) return nil; if (null_or_missing_p(package)) { - package = user_package; + package = cur_package; } else if (stringp(package)) { val p = find_package(package); if (!p) @@ -4893,25 +4893,9 @@ val keywordp(val sym) return tnil(sym && symbolp(sym) && sym->s.package == keyword_package_var); } -loc get_user_package(void) +val get_current_package(void) { - if (nilp(user_package_s)) - return mkcloc(user_package_var); - return lookup_global_var_l(user_package_s); -} - -loc get_system_package(void) -{ - if (nilp(system_package_s)) - return mkcloc(system_package_var); - return lookup_global_var_l(system_package_s); -} - -loc get_keyword_package(void) -{ - if (nilp(keyword_package_s)) - return mkcloc(keyword_package_var); - return lookup_global_var_l(keyword_package_s); + return cdr(lookup_var(nil, package_s)); } val func_f0(val env, val (*fun)(val)) @@ -9435,11 +9419,12 @@ dot: break; case SYM: if (!pretty) { - if (obj->s.package != user_package) { - if (!obj->s.package) - put_char(chr('#'), out); - else if (obj->s.package != keyword_package) - put_string(obj->s.package->pk.name, out); + if (!obj->s.package) { + put_string(lit("#:"), out); + } else if (obj->s.package == keyword_package) { + put_char(chr(':'), out); + } else if (obj->s.package != cur_package) { + put_string(obj->s.package->pk.name, out); put_char(chr(':'), out); } } diff --git a/lib.h b/lib.h index 34c6b59d..9ebfe524 100644 --- a/lib.h +++ b/lib.h @@ -412,12 +412,13 @@ INLINE val chr(wchar_t ch) #define lit(strlit) lit_noex(strlit) -#define keyword_package (deref(get_keyword_package())) -#define user_package (deref(get_user_package())) -#define system_package (deref(get_system_package())) +#define keyword_package keyword_package_var +#define user_package user_package_var +#define system_package system_package_var +#define cur_package (get_current_package()) extern val system_package_var, keyword_package_var, user_package_var; -extern val keyword_package_s, system_package_s, user_package_s; +extern val package_s, keyword_package_s, system_package_s, user_package_s; extern val null_s, t, cons_s, str_s, chr_s, fixnum_sl; extern val sym_s, pkg_s, fun_s, vec_s; extern val stream_s, hash_s, hash_iter_s, lcons_s, lstr_s, cobj_s, cptr_s; @@ -788,9 +789,7 @@ val symbolp(val sym); val symbol_name(val sym); val symbol_package(val sym); val keywordp(val sym); -loc get_user_package(void); -loc get_system_package(void); -loc get_keyword_package(void); +val get_current_package(void); val func_f0(val, val (*fun)(val env)); val func_f1(val, val (*fun)(val env, val)); val func_f2(val, val (*fun)(val env, val, val)); diff --git a/lisplib.c b/lisplib.c index 46514d3b..97cdedb9 100644 --- a/lisplib.c +++ b/lisplib.c @@ -29,9 +29,11 @@ #include #include #include +#include #include "config.h" #include "lib.h" #include "eval.h" +#include "signal.h" #include "stream.h" #include "hash.h" #include "gc.h" @@ -443,9 +445,16 @@ void lisplib_init(void) val lisplib_try_load(val sym) { val fun = gethash(dl_table, sym); - debug_state_t ds; - return if2(fun, (ds = debug_set_state(opt_dbg_autoload ? 0 : -1, - opt_dbg_autoload), - funcall(fun), - debug_restore_state(ds), t)); + + if (fun) { + debug_state_t ds = debug_set_state(opt_dbg_autoload ? 0 : -1, opt_dbg_autoload); + val saved_dyn_env = dyn_env; + dyn_env = make_env(nil, nil, dyn_env); + env_vbind(dyn_env, package_s, user_package); + funcall(fun); + dyn_env = saved_dyn_env; + debug_restore_state(ds); + return t; + } + return nil; } diff --git a/parser.c b/parser.c index 655ee8f1..bf243711 100644 --- a/parser.c +++ b/parser.c @@ -634,7 +634,7 @@ static void find_matching_syms(lino_completions_t *cpl, val line_prefix, char par, val force_qualify) { - val qualify = tnil(force_qualify || package != user_package); + val qualify = tnil(force_qualify || package != cur_package); val pkg_name = if2(qualify, if3(package == keyword_package && !force_qualify, lit(""), @@ -761,7 +761,7 @@ static void provide_completions(const char *data, int dwim = (prev == '['); char par = (!pprev || (!quote && !meth && !ppar) || dwim) ? prev : 0; - find_matching_syms(cpl, or2(package, user_package), + find_matching_syms(cpl, or2(package, cur_package), sym_pfx, line_pfx, par, if2(package, null(keyword))); } } diff --git a/parser.y b/parser.y index 6a43f664..2c1c31c7 100644 --- a/parser.y +++ b/parser.y @@ -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 = user_package, sym; + val sym_name = nil, pkg_name = nil, package = cur_package, sym; if (leading_at) { if (!meta_allowed) { diff --git a/txr.1 b/txr.1 index 91127f58..68081588 100644 --- a/txr.1 +++ b/txr.1 @@ -38743,6 +38743,25 @@ a leading colon. The is for internal symbols, helping the implementation avoid name clashes with user code in some situations. +These variables shouldn't be modified. If they are modified, the consequences +are unspecified. + +.coNP Special variable @ *package* +.desc +This variable holds the current package. The top-level binding of this +variable is initialized to the user package: the same package object +which is held in the +.code user-package +variable. + +The current package is used as the default package for interning symbol tokens +which do not carry the colon-delimited package prefix. + +The current package also affects printing. When a symbol is printed whose +home package matches the current package, it is printed without a package +prefix. (Keyword symbols are always printed with the colon prefix, even if the +keyword package is current.) + .coNP Function @ make-sym .synb .mets (make-sym << name ) @@ -38901,7 +38920,7 @@ should be a package. If .meta package is not supplied, then the value taken is that of -.codn *user-package* . +.codn *package* . The .code intern @@ -38930,7 +38949,7 @@ must be a symbol and package object, respectively. If .meta package is not given, then it defaults to the value of -.codn *user-package* . +.codn *package* . The .code rehome-sym -- cgit v1.2.3