New function, expand-right.

* eval.c (expand_right_fun, expand_right): New static
functions.
(eval_init): Register expand-right intrinsic.

* txr.1: Documented expand-right.

2 files changed, 101 insertions, 0 deletions

diff --git a/eval.c b/eval.c
index 68e4869b..fa8a8757 100644
--- a/eval.c
+++ b/eval.c
@@ -3633,6 +3633,34 @@ static val ginterate(val while_pred, val gen_fun, val init_val)
   }
 }
 
+static val expand_right_fun(val env, val lcons)
+{
+  cons_bind (pair, gen_fun, env);
+  cons_bind (elem, init_val, pair);
+
+  val next_pair = funcall1(gen_fun, init_val);
+
+  rplaca(lcons, elem);
+
+  if (next_pair) {
+    rplacd(lcons, make_lazy_cons(lcons_fun(lcons)));
+    rplaca(env, next_pair);
+  } else {
+    rplacd(lcons, nil);
+  }
+
+  return nil;
+}
+
+static val expand_right(val gen_fun, val init_val)
+{
+  val pair = funcall1(gen_fun, init_val);
+
+  if (!pair)
+    return nil;
+
+  return make_lazy_cons(func_f1(cons(pair, gen_fun), expand_right_fun));
+}
 
 static val repeat_infinite_func(val env, val lcons)
 {
@@ -4659,6 +4687,7 @@ void eval_init(void)
   reg_fun(generate_s, func_n2(generate));
   reg_fun(intern(lit("giterate"), user_package), func_n3o(giterate, 2));
   reg_fun(intern(lit("ginterate"), user_package), func_n3o(ginterate, 2));
+  reg_fun(intern(lit("expand-right"), user_package), func_n2(expand_right));
   reg_fun(intern(lit("repeat"), user_package), func_n2o(repeat, 1));
   reg_fun(intern(lit("pad"), user_package), func_n3o(pad, 1));
   reg_fun(intern(lit("weave"), user_package), func_n0v(weavev));
diff --git a/txr.1 b/txr.1
index 58c07039..789c06b6 100644
--- a/txr.1
+++ b/txr.1
@@ -15837,6 +15837,78 @@ then the list is terminated, and no more items are produced.
   (ginterate (op > 5) (op + 1) 0) -> (0 1 2 3 4 5)
 .cble
 
+.coNP Function @ expand-right
+.synb
+.mets (expand-right < gen-fun << value )
+.syne
+.desc
+The
+.code expand-right
+is a complement to
+.codn reduce-right ,
+with lazy semantics.
+
+The
+.meta gen-fun
+parameter is a function, which must accept a single argument,
+and return either a cons pair
+or
+.codn nil .
+
+The
+.meta value
+parameter is any value.
+
+The first call to
+.meta gen-fun
+receives
+.metn value .
+
+The return value is interpreted as follows. If
+.meta gen-fun
+returns a cons cell pair
+.cblk
+.meti >> ( elem . << next )
+.cble
+then
+.meta elem
+specifies the element to be added to the lazy list,
+and
+.meta next
+specifies the value to be passed to the next call
+to
+.metn gen-fun .
+If
+.meta gen-fun
+returns
+.code nil
+then the lazy list ends.
+
+.TP* Examples:
+
+.cblk
+  ;; Count down from 5 to 1 using explicit lambda
+  ;; for gen-fun:
+
+  (expand-right
+    (lambda (item)
+      (if (zerop item) nil
+        (cons item (pred item))))
+    5)
+  --> (5 4 3 2 1)
+
+  ;; Using functional combinators:
+  [expand-right [iff zerop nilf [callf cons identity pred]] 5]
+  --> (5 4 3 2 1)
+
+  ;; Include zero:
+  [expand-right
+    [iff null
+       nilf
+       [callf cons identity [iff zerop nilf pred]]] 5]
+  --> (5 4 3 2 1 0)
+.cble
+
 .coNP Function @ repeat
 .synb
 .mets (repeat < list <> [ count ])