interpreter: correct semantics of special var args.

In this patch we eliminate the special operator
sys:with-dyn-rebinds, and implement correct semantics for
dynamically scoped variables that occur in argument
lists.

* eval.c (with_dyn_rebinds_s): Symbol variable removed.
(bind_args): Handle special variables dynamically:
for each symbol that appears, check whether it is a special
and treat accordingly by allocating a new dynamic environment
if necessary, and binding in that environment.
This adds overhead, which is why I moved away from this
approach in the past. But now that there is a compiler,
overhead in the interpreter matters less. Correct semantics
is more important.
(expand_params): Greatly simplified for not having to wrap the
sys:with-dyn-rebinds operator around the body.
(funcall_interp): Since bind_args can now extend the dynamic
environment, it is necessary to save and restore dyn_env
around it. Another call to bind_args occurs in op_catch;
that already saves and restores dyn_env.
(op_with_dyn_rebinds): Static function removed.
(do_expand): with-dyn-rebinds-s case removed.
(eval_init): Removed interning of sys:with-dyn-rebinds
symbol and registration of special op.

* protsym.c: Regenerated.

* compiler.tl (compiler compile): Remove case which handles
sys:with-dyn-rebinds.

3 files changed, 92 insertions, 60 deletions

diff --git a/eval.c b/eval.c
index 957c68d8..5068774e 100644
--- a/eval.c
+++ b/eval.c
@@ -97,7 +97,7 @@ val op_s, ap_s, identity_s, apf_s, ipf_s;
 val ret_s, aret_s;
 val hash_lit_s, hash_construct_s, struct_lit_s, qref_s, uref_s;
 val vector_lit_s, vec_list_s;
-val macro_time_s, with_dyn_rebinds_s, macrolet_s;
+val macro_time_s, macrolet_s;
 val defsymacro_s, symacrolet_s, prof_s, switch_s;
 val fbind_s, lbind_s, flet_s, labels_s;
 val opip_s, oand_s, chain_s, chand_s;
@@ -756,6 +756,7 @@ static val squash_menv_deleting_range(val menv, val upto_menv)
 static val bind_args(val env, val params, struct args *args, val ctx)
 {
   val new_env = make_env(nil, nil, env);
+  val dyn_env_made = nil;
   val optargs = nil;
   cnum index = 0;
   uw_frame_t uw_cc;
@@ -767,6 +768,7 @@ static val bind_args(val env, val params, struct args *args, val ctx)
     val arg;
     val initform = nil;
     val presentsym = nil;
+    val special_p = nil;
 
     if (param == colon_k) {
       optargs = t;
@@ -785,6 +787,13 @@ static val bind_args(val env, val params, struct args *args, val ctx)
       }
     }
 
+    if ((special_p = special_var_p(param))) {
+      if (!dyn_env_made) {
+        dyn_env = make_env(nil, nil, dyn_env);
+        dyn_env_made = t;
+      }
+    }
+
     arg = args_get(args, &index);
 
     if (optargs) {
@@ -794,17 +803,30 @@ static val bind_args(val env, val params, struct args *args, val ctx)
       if (arg == colon_k) {
         if (initform) {
           initval = eval(initform, new_env, ctx);
-          new_env = make_env(nil, nil, new_env);
+          if (!special_p)
+            new_env = make_env(nil, nil, new_env);
         }
       } else {
         initval = arg;
         present = t;
       }
-      env_vbind(new_env, param, initval);
-      if (presentsym)
-        env_vbind(new_env, presentsym, present);
+      if (special_p) {
+        env_vbind(dyn_env, param, initval);
+      } else {
+        env_vbind(new_env, param, initval);
+      }
+      if (presentsym) {
+        if (special_var_p(presentsym)) {
+          env_vbind(dyn_env, presentsym, present);
+        } else {
+          env_vbind(new_env, presentsym, present);
+        }
+      }
     } else {
-      env_vbind(new_env, param, arg);
+      if (special_p)
+        env_vbind(dyn_env, param, arg);
+      else
+        env_vbind(new_env, param, arg);
     }
   }
 
@@ -823,19 +845,62 @@ static val bind_args(val env, val params, struct args *args, val ctx)
         val presentsym = pop(&param);
         val initval = eval(initform, new_env, ctx);
 
-        new_env = make_env(nil, nil, new_env);
-        env_vbind(new_env, sym, initval);
-        if (presentsym)
-          env_vbind(new_env, presentsym, nil);
+        if (special_var_p(sym)) {
+          if (!dyn_env_made) {
+            dyn_env = make_env(nil, nil, dyn_env);
+            dyn_env_made = t;
+          }
+          env_vbind(dyn_env, sym, initval);
+        } else {
+          new_env = make_env(nil, nil, new_env);
+          env_vbind(new_env, sym, initval);
+        }
+
+        if (presentsym) {
+          if (special_var_p(presentsym)) {
+            if (!dyn_env_made) {
+              dyn_env = make_env(nil, nil, dyn_env);
+              dyn_env_made = t;
+            }
+            env_vbind(dyn_env, presentsym, nil);
+          } else {
+            env_vbind(new_env, presentsym, nil);
+          }
+        }
       } else {
-        env_vbind(new_env, param, nil);
+        if (special_var_p(param)) {
+          if (!dyn_env_made) {
+            dyn_env = make_env(nil, nil, dyn_env);
+            dyn_env_made = t;
+          }
+          env_vbind(dyn_env, param, nil);
+        } else {
+          env_vbind(new_env, param, nil);
+        }
       }
       params = cdr(params);
     }
-    if (bindable(params))
-      env_vbind(new_env, params, nil);
+    if (bindable(params)) {
+      if (special_var_p(params)) {
+        if (!dyn_env_made) {
+          dyn_env = make_env(nil, nil, dyn_env);
+          dyn_env_made = t;
+        }
+        env_vbind(dyn_env, params, nil);
+      } else {
+        env_vbind(new_env, params, nil);
+      }
+    }
   } else if (params) {
-    env_vbind(new_env, params, args_get_rest(args, index));
+    if (special_var_p(params)) {
+      if (!dyn_env_made) {
+        dyn_env = make_env(nil, nil, dyn_env);
+        dyn_env_made = t;
+      }
+      env_vbind(dyn_env, params, args_get_rest(args, index));
+    } else {
+      env_vbind(new_env, params, args_get_rest(args, index));
+    }
   } else if (args_more(args, index)) {
     eval_error(ctx, lit("~s: too many arguments"),
                ctx_name(ctx), nao);
@@ -1043,16 +1108,11 @@ static val expand_params(val params, val body, val menv,
                          val macro_style_p, val form)
 {
   val specials = nil;
-  cons_bind (params_ex0, body_ex0, expand_param_macro(params, body,
-                                                      menv, form));
-  int have_rebinds = consp(body_ex0) && consp(car(body_ex0)) && caar(body_ex0) == with_dyn_rebinds_s;
+  cons_bind (params_ex0, body_ex, expand_param_macro(params, body,
+                                                     menv, form));
   val params_ex = expand_params_rec(params_ex0, menv, macro_style_p,
                                     form, &specials);
-  val body_out = if3(!have_rebinds && specials,
-                     rlcp(cons(cons(with_dyn_rebinds_s, cons(specials, body_ex0)),
-                               nil), nil),
-                     body_ex0);
-  return cons(params_ex, body_out);
+  return cons(params_ex, body_ex);
 }
 
 static val get_opt_param_syms(val params)
@@ -1361,8 +1421,11 @@ val funcall_interp(val interp_fun, struct args *args)
   val def = cdr(fun);
   val params = car(def);
   val body = cdr(def);
+  val saved_de = dyn_env;
   val fun_env = bind_args(env, params, args, interp_fun);
-  return eval_progn(body, fun_env, body);
+  val ret = eval_progn(body, fun_env, body);
+  dyn_env = saved_de;
+  return ret;
 }
 
 val eval_intrinsic(val form, val env)
@@ -2791,27 +2854,6 @@ static val op_quasi_lit(val form, val env)
   return cat_str(subst_vars(rest(form), env, nil), nil);
 }
 
-static val op_with_dyn_rebinds(val form, val env)
-{
-  val rebind_vars = cadr(form);
-  val body = cddr(form);
-  list_collect_decl (dbinds, ptail);
-
-  for (; rebind_vars; rebind_vars = cdr(rebind_vars)) {
-    val sym = car(rebind_vars);
-    val binding = lookup_var(env, car(rebind_vars));
-    ptail = list_collect(ptail, cons(sym, cdr(binding)));
-    rplacd(binding, unbound_s);
-  }
-
-  {
-    val saved_de = set_dyn_env(make_env(dbinds, nil, dyn_env));
-    val result = eval_progn(body, env, form);
-    set_dyn_env(saved_de);
-    return result;
-  }
-}
-
 val prof_call(val (*fun)(mem_t *ctx), mem_t *ctx)
 {
   clock_t start_time = clock();
@@ -4583,13 +4625,6 @@ again:
       if (params_ex == params && expr_ex == expr && body_ex == body)
         return form;
       return rlcp(cons(sym, cons(params_ex, cons(expr_ex, body_ex))), form);
-    } else if (sym == with_dyn_rebinds_s) {
-      val body = rest(form);
-      val syms = pop(&body);
-      val body_ex = expand_progn(body, menv);
-      if (body_ex == body)
-        return form;
-      return rlcp(cons(sym, cons(syms, body_ex)), form);
     } else if (sym == fun_s) {
       val arg = second(form);
       if (consp(arg) && car(arg) == lambda_s) {
@@ -6119,7 +6154,6 @@ void eval_init(void)
   macro_time_s = intern(lit("macro-time"), user_package);
   macrolet_s = intern(lit("macrolet"), user_package);
   symacrolet_s = intern(lit("symacrolet"), user_package);
-  with_dyn_rebinds_s = intern(lit("with-dyn-rebinds"), system_package);
   whole_k = intern(lit("whole"), keyword_package);
   form_k = intern(lit("form"), keyword_package);
   special_s = intern(lit("special"), system_package);
@@ -6187,7 +6221,6 @@ void eval_init(void)
   reg_op(quasi_s, op_quasi_lit);
   reg_op(sys_catch_s, op_catch);
   reg_op(handler_bind_s, op_handler_bind);
-  reg_op(with_dyn_rebinds_s, op_with_dyn_rebinds);
   reg_op(prof_s, op_prof);
   reg_op(switch_s, op_switch);
   reg_op(intern(lit("upenv"), system_package), op_upenv);
diff --git a/protsym.c b/protsym.c
index 5c0db635..87e2ff42 100644
--- a/protsym.c
+++ b/protsym.c
@@ -128,9 +128,9 @@ extern val ushort_s, uw_protect_s, val_s, var_k, var_s;
 extern val vars_k, vec_list_s, vec_s, vecref_s, vector_lit_s;
 extern val vm_closure_s, vm_desc_s, void_s, warning_s, wchar_s;
 extern val weak_keys_k, weak_vals_k, when_s, while_s, while_star_s;
-extern val whole_k, wild_s, with_dyn_rebinds_s, word_char_k, wrap_k;
-extern val wstr_d_s, wstr_s, year_s, zap_s, zarray_s;
-extern val zeroplus_s, zone_s;
+extern val whole_k, wild_s, word_char_k, wrap_k, wstr_d_s;
+extern val wstr_s, year_s, zap_s, zarray_s, zeroplus_s;
+extern val zone_s;
 
 #if CONFIG_DEBUG_SUPPORT
 extern val debug_quit_s;
@@ -259,9 +259,9 @@ val *protected_sym[] = {
   &vars_k, &vec_list_s, &vec_s, &vecref_s, &vector_lit_s,
   &vm_closure_s, &vm_desc_s, &void_s, &warning_s, &wchar_s,
   &weak_keys_k, &weak_vals_k, &when_s, &while_s, &while_star_s,
-  &whole_k, &wild_s, &with_dyn_rebinds_s, &word_char_k, &wrap_k,
-  &wstr_d_s, &wstr_s, &year_s, &zap_s, &zarray_s,
-  &zeroplus_s, &zone_s,
+  &whole_k, &wild_s, &word_char_k, &wrap_k, &wstr_d_s,
+  &wstr_s, &year_s, &zap_s, &zarray_s, &zeroplus_s,
+  &zone_s,
 
 #if CONFIG_DEBUG_SUPPORT
   &debug_quit_s,
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index 4275daf0..2d8962e3 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -320,7 +320,6 @@
             (defsymacro me.(compile oreg env (expand-defsymacro form)))
             (sys:upenv me.(compile oreg env.up (cadr form)))
             (sys:dvbind me.(compile oreg env (caddr form)))
-            (sys:with-dyn-rebinds me.(comp-progn oreg env (cddr form)))
             (sys:load-time-lit me.(comp-load-time-lit oreg env form))
             ((macrolet symacrolet macro-time)
              (compile-error form "unexpanded ~s encountered" sym))