From 1878f60ebdacdd52fb05a171eb07b4bc91e9704c Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Mon, 3 Aug 2015 09:59:49 -0700
Subject: Switching some globals to lexical and changing some names.

* arith.c (arith-init): Changing *flo-...* from special to
lexical, and adding un-earmuffed variants. The earmuffed
versions are obsolescent.
Adding %pi% and %e% global lexicals. Earmuffed versions are
also made global lexical, and obsolescent.

* eval.c (lookup_global_var, lookup_global_var_l): New functions.
(lookup_var): Uses lookup_global_var.
(reg_varl): New function.
(reg_var): Uses reg_var.
(eval_init): Register global lexicals user-package, system-package
and keyword-package. Old symbols with earmuffs are obsoleted,
and also turned into global lexicals.
(top-vb, top-fb): Changed to lexical.

* eval.h (lookup_global_var, lookup_global_var_l, reg_varl):
Declared.

* genvim.txr: Scan ver.tl so that the lib-version variable
is included. Extract reg_varl calls.

* glob.c (glob_init): glob-err and other variables made lexical.

* lib.c (get_user_package, get_system_package, get_keyword_package):
Use lookup_global_var_l to avoid searching dynamic scope for
lexicals which cannot be dynamically rebound.

* share/txr/stdlib/ver.tl (lib-version): New global lexical variable.
(*lib-version*): Turned lexical. Obsolescent.

* signal.c (sig-init): sig-* variables turned lexical.

* sysif.c (sysif-init): s-*, poll-* and w-* variables turned lexical.

* syslog.c (syslog-init): log-* variables turned lexical.

* txr.c (sysroot-init): stdlib and *txr-version* variables turned
lexical. txr-version variable added, and *txr-version* is
obsolescent.
(txr-main): self-path variable added. *self-path* turns lexical
and is obsolescent.

* txr.1: Documentation updated. Lexical variables not referred
to as special. Special variables referred to as special.
---
 eval.c | 43 +++++++++++++++++++++++++++++++------------
 1 file changed, 31 insertions(+), 12 deletions(-)

(limited to 'eval.c')

diff --git a/eval.c b/eval.c
index fa2f4c73..bfe7ade2 100644
--- a/eval.c
+++ b/eval.c
@@ -168,10 +168,15 @@ noreturn static val eval_error(val form, val fmt, ...)
   abort();
 }
 
-val lookup_var(val env, val sym)
+val lookup_global_var(val sym)
 {
   uses_or2;
+  return or2(gethash(top_vb, sym),
+             if2(lisplib_try_load(sym), gethash(top_vb, sym)));
+}
 
+val lookup_var(val env, val sym)
+{
   if (env) {
     type_check(env, ENV);
 
@@ -188,8 +193,7 @@ val lookup_var(val env, val sym)
       return binding;
   }
 
-  return or2(gethash(top_vb, sym),
-             if2(lisplib_try_load(sym), gethash(top_vb, sym)));
+  return lookup_global_var(sym);
 }
 
 static val lookup_sym_lisp1(val env, val sym)
@@ -226,6 +230,12 @@ loc lookup_var_l(val env, val sym)
   return if3(binding, cdr_l(binding), nulloc);
 }
 
+loc lookup_global_var_l(val sym)
+{
+  val binding = lookup_global_var(sym);
+  return if3(binding, cdr_l(binding), nulloc);
+}
+
 val lookup_fun(val env, val sym)
 {
   uses_or2;
@@ -3761,10 +3771,15 @@ static void reg_mac(val sym, mefun_t fun)
   sethash(builtin, sym, defmacro_s);
 }
 
-void reg_var(val sym, val val)
+void reg_varl(val sym, val val)
 {
   assert (sym != nil);
   sethash(top_vb, sym, cons(sym, val));
+}
+
+void reg_var(val sym, val val)
+{
+  reg_varl(sym, val);
   mark_special(sym);
 }
 
@@ -4406,12 +4421,16 @@ void eval_init(void)
   reg_fun(intern(lit("pprinl"), user_package), func_n2o(pprinl, 1));
   reg_fun(intern(lit("tprint"), user_package), func_n2o(tprint, 1));
 
-  reg_var(user_package_s = intern(lit("*user-package*"), user_package_var),
-          user_package_var);
-  reg_var(system_package_s = intern(lit("*system-package*"), user_package_var),
-          system_package_var);
-  reg_var(keyword_package_s = intern(lit("*keyword-package*"), user_package_var),
-          keyword_package_var);
+  reg_varl(user_package_s = intern(lit("user-package"), user_package_var),
+           user_package_var);
+  reg_varl(system_package_s = intern(lit("system-package"), user_package_var),
+           system_package_var);
+  reg_varl(keyword_package_s = intern(lit("keyword-package"), user_package_var),
+           keyword_package_var);
+
+  reg_varl(intern(lit("*user-package*"), user_package), user_package_var);
+  reg_varl(intern(lit("*system-package*"), user_package), system_package_var);
+  reg_varl(intern(lit("*keyword-package*"), user_package), keyword_package_var);
 
   reg_fun(intern(lit("make-sym"), user_package), func_n1(make_sym));
   reg_fun(intern(lit("gensym"), user_package), func_n1o(gensym, 0));
@@ -4555,8 +4574,8 @@ void eval_init(void)
   reg_fun(intern(lit("make-like"), user_package), func_n2(make_like));
   reg_fun(intern(lit("nullify"), user_package), func_n1(nullify));
 
-  reg_var(intern(lit("top-vb"), system_package), top_vb);
-  reg_var(intern(lit("top-fb"), system_package), top_fb);
+  reg_varl(intern(lit("top-vb"), system_package), top_vb);
+  reg_varl(intern(lit("top-fb"), system_package), top_fb);
   reg_fun(intern(lit("symbol-value"), user_package), func_n1(symbol_value));
   reg_fun(intern(lit("symbol-function"), user_package), func_n1(symbol_function));
   reg_fun(intern(lit("boundp"), user_package), func_n1(boundp));
-- 
cgit v1.2.3