expand-left and nexpand-left functions.

* eval.c (expand_left, nexpand_left): New static functions.
(eval_init): Registered expand-left and nexpand-left
intrinsics.

* txr.1: Documented.

2 files changed, 108 insertions, 1 deletions

diff --git a/eval.c b/eval.c
index 3d7cee89..62eeb7d2 100644
--- a/eval.c
+++ b/eval.c
@@ -4074,6 +4074,39 @@ static val expand_right(val gen_fun, val init_val)
   return make_lazy_cons(func_f1(cons(pair, gen_fun), expand_right_fun));
 }
 
+static val expand_left(val gen_fun, val init_val)
+{
+  val out = nil;
+
+  for (;;) {
+    val pair = funcall1(gen_fun, init_val);
+    if (pair) {
+      cons_bind (elem, next, pair);
+      init_val = next;
+      out = cons(elem, out);
+      continue;
+    }
+
+    return out;
+  }
+}
+
+static val nexpand_left(val gen_fun, val init_val)
+{
+  val out = nil;
+
+  for (;;) {
+    val pair = funcall1(gen_fun, init_val);
+    if (pair) {
+      init_val = cdr(pair);
+      out = rplacd(pair, out);
+      continue;
+    }
+
+    return out;
+  }
+}
+
 static val repeat_infinite_func(val env, val lcons)
 {
   if (!car(env))
@@ -5169,6 +5202,8 @@ void eval_init(void)
   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("expand-left"), user_package), func_n2(expand_left));
+  reg_fun(intern(lit("nexpand-left"), user_package), func_n2(nexpand_left));
   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 3b1bf55b..a27ab08b 100644
--- a/txr.1
+++ b/txr.1
@@ -16847,7 +16847,7 @@ then the list is terminated, and no more items are produced.
 .desc
 The
 .code expand-right
-is a complement to
+function is a complement to
 .codn reduce-right ,
 with lazy semantics.
 
@@ -16912,6 +16912,78 @@ then the lazy list ends.
   --> (5 4 3 2 1 0)
 .cble
 
+.coNP Functions @ expand-left and @ nexpand-left
+.synb
+.mets (expand-left < gen-fun << value )
+.mets (nexpand-left < gen-fun << value )
+.syne
+.desc
+The
+.code expand-left
+function is a companion to
+.codn expand-right .
+
+Unlike
+.codn expand-right ,
+it has eager semantics: it calls
+.code gen-fun
+repeatedly and accumulates an output list, not returning
+until
+.code gen-fun
+returns
+.codn nil .
+
+The semantics is as follows.
+.code expand-left
+initializes an empty accumulation list. Then
+.meta gen-fun
+is called, with
+.meta value
+as its argument.
+
+If
+.meta gen-fun
+it returns a cons cell, then the
+.code car
+of that cons cell is pushed onto the accumulation list,
+and the procedure is repeated:
+.meta gen-fun
+is called again, with
+.code cdr
+taking the place of
+.meta value.
+
+If
+.meta gen-fun
+returns
+.codn nil ,
+then the accumulation list is returned.
+
+If the expression
+.code (expand-right f v)
+produces a terminating list, then the following equivalence holds:
+
+.cblk
+  (expand-left f v) <--> (reverse (expand-right f v))
+.cble
+
+Of course, the equivalence cannot hold for arguments to
+.code expand-left
+which produce an infinite list.
+
+The
+.code nexpand-left
+function is a destructive version of
+.codn expand-left .
+
+The list returned by
+.code nexpand-left
+is composed of the cons cells returned by
+.code gen-fun
+whereas the list returned by
+.code expand-left
+is composed of freshly allocated cons cells.
+
 .coNP Function @ repeat
 .synb
 .mets (repeat < list <> [ count ])