From 6e5e31d0a8654cd53d56e6c5f2c791572d97c4dc Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Mon, 29 Feb 2016 06:10:36 -0800
Subject: 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.
---
 eval.c | 35 +++++++++++++++++++++++++++++++++++
 1 file changed, 35 insertions(+)

(limited to 'eval.c')

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));
-- 
cgit v1.2.3