summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2016-11-08 21:09:45 -0800
committerKaz Kylheku <kaz@kylheku.com>2016-11-08 21:09:45 -0800
commit847a7b6c5292bd2126303e3ab7a6916657e13a71 (patch)
tree35e76797d42dbdae9171ab436f492e754576cf78
parent3ccdd5c9bfc6c8a8812ef6dab12dc1a1cd2bc0ee (diff)
downloadtxr-847a7b6c5292bd2126303e3ab7a6916657e13a71.tar.gz
txr-847a7b6c5292bd2126303e3ab7a6916657e13a71.tar.bz2
txr-847a7b6c5292bd2126303e3ab7a6916657e13a71.zip
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*).
-rw-r--r--eval.c2
-rw-r--r--lib.c37
-rw-r--r--lib.h13
-rw-r--r--lisplib.c19
-rw-r--r--parser.c4
-rw-r--r--parser.y2
-rw-r--r--txr.123
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 <wchar.h>
#include <dirent.h>
#include <stdarg.h>
+#include <signal.h>
#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