* eval.c (each_s, each_star_s, collect_each_s, collect_each_star_s):

New symbol variables.
(op_each): New static function.
(expand): Handle the four new operators.
(eval_init): Intern new symbols, register new operators.

* txr.1: Documented each, each*, collect-each and collect-each*.

* txr.vim: Updated.

1 files changed, 59 insertions, 2 deletions

diff --git a/eval.c b/eval.c
index 4cf97c6f..73889a72 100644
--- a/eval.c
+++ b/eval.c
@@ -54,7 +54,9 @@ val eval_error_s;
 val progn_s, prog1_s, let_s, let_star_s, lambda_s, call_s;
 val cond_s, if_s, defvar_s, defun_s;
 val inc_s, dec_s, push_s, pop_s, flip_s, gethash_s, car_s, cdr_s, vecref_s;
-val for_s, for_star_s, dohash_s, uw_protect_s, return_s, return_from_s;
+val for_s, for_star_s, each_s, each_star_s, collect_each_s, collect_each_star_s;
+val dohash_s;
+val uw_protect_s, return_s, return_from_s;
 val list_s, append_s, apply_s, gen_s, generate_s;
 val delay_s, promise_s;
 
@@ -461,6 +463,50 @@ static val op_let(val form, val env)
   return eval_progn(body, make_env(new_bindings, nil, env), form);
 }
 
+static val op_each(val form, val env)
+{
+  uses_or2;
+  val each = first(form);
+  val args = rest(form);
+  val vars = first(args);
+  val body = rest(args);
+  val star = or2(eq(each, each_star_s), eq(each, collect_each_star_s));
+  val collect = or2(eq(each, collect_each_s), eq(each, collect_each_star_s));
+  val new_bindings = bindings_helper(vars, env, star, form);
+  val lists = mapcar(cdr_f, new_bindings);
+  list_collect_decl (collection, ptail);
+
+  uw_block_begin (nil, result);
+
+  for (;;) {
+    val biter, liter;
+    
+    for (biter = new_bindings, liter = lists; biter; 
+         biter = cdr(biter), liter = cdr(liter))
+    {
+      val binding = car(biter);
+      val list = car(liter);
+      if (!list)
+        goto out;
+      rplacd(binding, car(list));
+      rplaca(liter, cdr(list));
+    }
+  
+    {
+      val res = eval_progn(body, make_env(new_bindings, nil, env), form);
+      if (collect)
+        list_collect(ptail, res);
+    }
+  }
+
+out:
+  result = collection;
+
+  uw_block_end;
+
+  return result;
+}
+
 static val op_lambda(val form, val env)
 {
   return func_interp(env, form);
@@ -1010,7 +1056,10 @@ val expand(val form)
   } else {
     val sym = car(form);
 
-    if (sym == let_s || sym == let_star_s || sym == lambda_s) {
+    if (sym == let_s || sym == let_star_s || sym == lambda_s || 
+        sym == each_s || sym == each_star_s || sym == collect_each_s ||
+        sym == collect_each_star_s)
+    {
       val body = rest(rest(form));
       val vars = second(form);
       val body_ex = expand_forms(body);
@@ -1411,6 +1460,10 @@ void eval_init(void)
   flip_s = intern(lit("flip"), user_package);
   for_s = intern(lit("for"), user_package);
   for_star_s = intern(lit("for*"), user_package);
+  each_s = intern(lit("each"), user_package);
+  each_star_s = intern(lit("each*"), user_package);
+  collect_each_s = intern(lit("collect-each"), user_package);
+  collect_each_star_s = intern(lit("collect-each*"), user_package);
   dohash_s = intern(lit("dohash"), user_package);
   uw_protect_s = intern(lit("unwind-protect"), user_package);
   return_s = intern(lit("return"), user_package);
@@ -1434,6 +1487,10 @@ void eval_init(void)
   sethash(op_table, progn_s, cptr((mem_t *) op_progn));
   sethash(op_table, prog1_s, cptr((mem_t *) op_prog1));
   sethash(op_table, let_s, cptr((mem_t *) op_let));
+  sethash(op_table, each_s, cptr((mem_t *) op_each));
+  sethash(op_table, each_star_s, cptr((mem_t *) op_each));
+  sethash(op_table, collect_each_s, cptr((mem_t *) op_each));
+  sethash(op_table, collect_each_star_s, cptr((mem_t *) op_each));
   sethash(op_table, let_star_s, cptr((mem_t *) op_let));
   sethash(op_table, lambda_s, cptr((mem_t *) op_lambda));
   sethash(op_table, call_s, cptr((mem_t *) op_call));