4 files changed, 62 insertions, 9 deletions

diff --git a/eval.c b/eval.c
index bea71dd4..8a2e99ed 100644
--- a/eval.c
+++ b/eval.c
@@ -4212,6 +4212,7 @@ void eval_init(void)
   reg_fun(intern(lit("flatten"), user_package), func_n1(flatten));
   reg_fun(intern(lit("flatten*"), user_package), func_n1(lazy_flatten));
   reg_fun(intern(lit("flatcar"), user_package), func_n1(flatcar));
+  reg_fun(intern(lit("flatcar*"), user_package), func_n1(lazy_flatcar));
   reg_fun(intern(lit("tuples"), user_package), func_n3o(tuples, 2));
   reg_fun(intern(lit("partition-by"), user_package), func_n2(partition_by));
   reg_fun(intern(lit("partition"), user_package), func_n2(partition));
diff --git a/lib.c b/lib.c
index 6de77669..4d0537b6 100644
--- a/lib.c
+++ b/lib.c
@@ -1521,6 +1521,53 @@ val flatcar(val tree)
   return flatcar(car(tree));
 }
 
+static val lazy_flatcar_scan(val tree, val *cont)
+{
+  for (;;) {
+    val a = car(tree);
+    val d = cdr(tree);
+
+    if (d != nil)
+      *cont = cons(d, *cont);
+
+    if (atom(a))
+      return a;
+
+    tree = a;
+  }
+}
+
+static val lazy_flatcar_func(val env, val lcons)
+{
+  val tree = car(env);
+  val cont = nil;
+  val atom = lazy_flatcar_scan(tree, &cont);
+
+  rplaca(lcons, atom);
+  rplaca(env, cont);
+
+  if (cont)
+    rplacd(lcons, make_lazy_cons(lcons_fun(lcons)));
+
+  return nil;
+}
+
+val lazy_flatcar(val tree)
+{
+  if (atom(tree)) {
+    return cons(tree, nil);
+  } else {
+    val cont = nil;
+    val nextatom = lazy_flatcar_scan(tree, &cont);
+
+    if (!cont)
+      return cons(nextatom, nil);
+
+    return make_lazy_cons(func_f1(cons(tree, nil), lazy_flatcar_func));
+  }
+}
+
+
 static val tuples_func(val env, val lcons)
 {
   list_collect_decl (out, ptail);
diff --git a/lib.h b/lib.h
index 5742231f..b9fa99e5 100644
--- a/lib.h
+++ b/lib.h
@@ -497,6 +497,7 @@ val ldiff(val list1, val list2);
 val flatten(val list);
 val lazy_flatten(val list);
 val flatcar(val list);
+val lazy_flatcar(val tree);
 val tuples(val n, val seq, val fill);
 val partition_by(val func, val seq);
 val partition(val seq, val indices);
diff --git a/txr.1 b/txr.1
index 1083ec39..937432a3 100644
--- a/txr.1
+++ b/txr.1
@@ -14735,19 +14735,14 @@ function produces a list whose elements are all of the
 .cod2 non- nil
 atoms contained in the structure of
 .metn list .
+
 The
 .code flatten*
 function
 works like
 .code flatten
-except that
-.code flatten
-creates and returns a complete
-flattened list, whereas
-.code flatten*
-produces a lazy list which is
-instantiated on demand. This is particularly useful when the input
-structure is itself lazy.
+except that it produces a lazy list. It can be used to lazily flatten an
+infinite lazy structure.
 
 .TP* Examples:
 .cblk
@@ -14762,9 +14757,10 @@ structure is itself lazy.
   (flatten '(((()) ()))) -> nil
 .cble
 
-.coNP Function @ flatcar
+.coNP Functions @ flatcar and @ flatcar*
 .synb
 .mets (flatcar << tree )
+.mets (flatcar* << tree )
 .syne
 .desc
 The
@@ -14787,6 +14783,14 @@ atoms which appear in
 .code cdr
 fields.
 
+The
+.code flatcar*
+function
+works like
+.code flatcar
+except that it produces a lazy list. It can be used to lazily flatten an
+infinite lazy structure.
+
 .TP* Examples:
 .cblk
   (flatcar '(1 2 () (3 4))) -> (1 2 nil 3 4)