From f8385842a53b392e7f5dd085b951de35760aa1b6 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sat, 6 Jun 2020 00:14:34 -0700
Subject: each: fix (each ()) segfault.

The (each ()) form should infinitely loop, and the compiled
version does. The interpreter crashes, when that is a
top-level form. The reason is that the underlying sys:each-op
operator uses an empty list of variable names as an indication
to use the bindings from the parent lexical environment.
And in that particular case, the let is also empty. The
whole thing looks like:

  (let () (sys:each-op each nil))

If this is a top-level expression, then op_let receives a null
environment pointer. Since it has no bindings to add, it
doesn't extend the environment chain and passes a null
environment pointer down to op_each, which that tries to use,
because it's told to reach into it for bindings.

Let's use the t symbol for that instead, so then the above
would look like:

  ;; the t and only the t means "access parent env"
  (let () (sys:each-op each t))

And then, let's also fix it so that t is never used in this
case when there are no vars:

  ;; no t, and so don't access parent env.
  (let () (sys:each-op each nil))

* eval.c (op_each): Get the bindings from the parent
environment if vars is t, rather than when it's null.
(me_each): When the symbols are not being inserted into the
sys:each-op form, then insert t to indicate that, rather than
nil. If the source form specifies an empty list of bindings,
then insert nil, not t.

* share/txr/stdlib/compiler.tl (expand-each): Get the list of
variable names from the parent lexical environment when vars
is t, rather than when it's null.
---
 eval.c                       | 9 +++++----
 share/txr/stdlib/compiler.tl | 2 +-
 2 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/eval.c b/eval.c
index 81b75a3f..405851f1 100644
--- a/eval.c
+++ b/eval.c
@@ -1838,9 +1838,9 @@ static val op_each(val form, val env)
   val body = args;
   val collect = eq(each, collect_each_s);
   val append = eq(each, append_each_s);
-  val bindings = if3(vars,
-                     get_bindings(vars, env),
-                     env->e.vbindings);
+  val bindings = if3(vars == t,
+                     env->e.vbindings,
+                     get_bindings(vars, env));
   val iters = mapcar(iter_from_binding_f, bindings);
   list_collect_decl (collection, ptail);
 
@@ -3073,7 +3073,8 @@ static val me_each(val form, val menv)
   (void) menv;
   return list(if3(star, let_star_s, let_s), vars,
               cons(each_op_s, cons(eff_each,
-                                   cons(if2(star || specials_occur, var_syms),
+                                   cons(if3(!vars || star || specials_occur,
+                                            var_syms, t),
                                         args))), nao);
 }
 
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index 36e33007..f245e9f5 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -1379,7 +1379,7 @@
 
 (defun expand-each (form env)
   (mac-param-bind form (op each-type vars . body) form
-    (unless vars
+    (when (eq vars t)
       (set vars [mapcar car env.vb]))
     (let* ((gens (mapcar (ret (gensym)) vars))
            (out (if (member each-type '(collect-each append-each))
-- 
cgit v1.2.3