* eval.c (gun_s): New global variable.

(me_gun): New static function.
(eval_init): New gun symbol interened, me_gun registered
as intrinsic macro.

* txr.1: Documented gun.

3 files changed, 51 insertions, 2 deletions

diff --git a/ChangeLog b/ChangeLog
index 2af57217..07ab3da3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,14 @@
 2014-02-26  Kaz Kylheku  <kaz@kylheku.com>
 
+	* eval.c (gun_s): New global variable.
+	(me_gun): New static function.
+	(eval_init): New gun symbol interened, me_gun registered
+	as intrinsic macro.
+
+	* txr.1: Documented gun.
+
+2014-02-26  Kaz Kylheku  <kaz@kylheku.com>
+
 	Converting expander special case code transformations into
 	formal macros that are in the top_mb table, make their symbols
 	fboundp and can be expanded with macroexpand.
diff --git a/eval.c b/eval.c
index 8be374d6..9f5c2d0a 100644
--- a/eval.c
+++ b/eval.c
@@ -85,7 +85,7 @@ val for_s, for_star_s, each_s, each_star_s, collect_each_s, collect_each_star_s;
 val append_each_s, append_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, rest_s;
+val list_s, append_s, apply_s, gen_s, gun_s, generate_s, rest_s;
 val delay_s, promise_s, op_s;
 val hash_lit_s, hash_construct_s;
 val vector_lit_s, vector_list_s;
@@ -1946,6 +1946,15 @@ static val me_gen(val form, val menv)
               list(lambda_s, nil, third(form), nao), nao);
 }
 
+static val me_gun(val form, val menv)
+{
+  val var = gensym(nil);
+  val expr = second(form);
+  (void) menv;
+  return list(let_s, cons(var, nil),
+              list(gen_s, list(set_s, var, expr, nao), var, nao), nao);
+}
+
 static val me_delay(val form, val menv)
 {
   (void) menv;
@@ -3027,6 +3036,7 @@ void eval_init(void)
   append_s = intern(lit("append"), user_package);
   apply_s = intern(lit("apply"), user_package);
   gen_s = intern(lit("gen"), user_package);
+  gun_s = intern(lit("gun"), user_package);
   generate_s = intern(lit("generate"), user_package);
   delay_s = intern(lit("delay"), user_package);
   promise_s = intern(lit("promise"), system_package);
@@ -3091,6 +3101,7 @@ void eval_init(void)
   reg_op(with_saved_vars_s, op_with_saved_vars);
 
   reg_mac(gen_s, me_gen);
+  reg_mac(gun_s, me_gun);
   reg_mac(delay_s, me_delay);
   reg_mac(op_s, me_op);
   reg_mac(do_s, me_op);
diff --git a/txr.1 b/txr.1
index 309a5cd9..f94af99d 100644
--- a/txr.1
+++ b/txr.1
@@ -7973,12 +7973,13 @@ Description:
 The repeat function produces an infinite lazy list formed by the repeatedly
 cycled catenation of the argument lists.
 
-.SS Macro gen
+.SS Macros gen and gun
 
 .TP
 Syntax:
 
   (gen <while-expression> <produce-item-expression>)
+  (gun <produce-item-expression>)
 
 .TP
 Description:
@@ -8000,6 +8001,34 @@ producing the lazy list. If the expression yields nil, then the operator
 returns the empty list nil. Otherwise, it instantiates the lazy list and
 invokes the <produce-item-expression> to force the first item.
 
+The gun macro similarly creates a lazy list according to the following
+rules. Each successive item of the lazy list is obtained as a result of
+evaluating <produce-item-expression>. However, when <produce-item-expression>
+yields nil, then the list terminates (without adding that nil as an item).
+
+Note 1: the form gun can be implemented as a macro-expanding to
+an instance of the gen operator, like this:
+
+  (defmacro gun (expr)
+    (let ((var (gensym)))
+      '(let (,var)
+         (gen (set ,var ,expr)
+              ,var))))
+
+This exploits the fact that the set operator returns the value that is
+assigned, so the set expression is tested as a condition by gen,
+while havin the side effect of storing the next item temporarily
+in a hidden variable.
+
+In turn, gen can be implemented as a macro expanding to some lambda
+functions which are passed to the generate function:
+
+  (defmacro gen (while-expr produce-expr)
+    '(generate (lambda () ,while-expr) (lambda () ,produce-expr)))
+
+Note 2: GEN can be considered as an acronym for Generate, testing Expression
+before Next item, whereas GUN stands for Generate Until Null.
+
 .TP
 
 Example: