* eval.c (eval_init): New function interned.

* lib.c:x (lazy_flatten_scan, lazy_flatten_func): New static functions.
(lazy_flatten): New function.

* lib.h (lazy_flatten): Declared.

* match.c (v_next): Use lazy_flatten instead of flatten for
processing a :list source. This means that @(next :list ...)
can be used to process infinite lazy lists.

* txr.1: Documented lazy-flatten.

6 files changed, 80 insertions, 3 deletions

diff --git a/ChangeLog b/ChangeLog
index 996a7e28..ed4a062b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+2011-12-25  Kaz Kylheku  <kaz@kylheku.com>
+
+	* eval.c (eval_init): New function interned.
+
+	* lib.c:x (lazy_flatten_scan, lazy_flatten_func): New static functions.
+	(lazy_flatten): New function.
+			
+	* lib.h (lazy_flatten): Declared.
+
+	* match.c (v_next): Use lazy_flatten instead of flatten for
+	processing a :list source. This means that @(next :list ...)
+	can be used to process infinite lazy lists.
+
+	* txr.1: Documented lazy-flatten.
+
 2011-12-23  Kaz Kylheku  <kaz@kylheku.com>
 
 	* rand.c (rand32): Moved.
diff --git a/eval.c b/eval.c
index 1a77deb1..f3025be0 100644
--- a/eval.c
+++ b/eval.c
@@ -1248,6 +1248,7 @@ void eval_init(void)
   reg_fun(intern(lit("reverse"), user_package), func_n1(reverse));
   reg_fun(intern(lit("ldiff"), user_package), func_n2(ldiff));
   reg_fun(intern(lit("flatten"), user_package), func_n1(flatten));
+  reg_fun(intern(lit("lazy-flatten"), user_package), func_n1(lazy_flatten));
   reg_fun(intern(lit("memq"), user_package), func_n2(memq));
   reg_fun(intern(lit("memqual"), user_package), func_n2(memqual));
   reg_fun(intern(lit("tree-find"), user_package), func_n3(tree_find));
diff --git a/lib.c b/lib.c
index 7240869b..a1663217 100644
--- a/lib.c
+++ b/lib.c
@@ -488,6 +488,62 @@ val flatten(val list)
   return mappend(func_n1(flatten), list);
 }
 
+/*
+ * Return the embedded list whose car is the non-nil atom in the given nested
+ * list, updating the escape stack in the process. If no such atom is found in
+ * the list, try to retreate up the stack to find it in the surrounding
+ * structure, finally returning nil if nothing is found.
+ */
+static val lazy_flatten_scan(val list, val *escape)
+{
+  for (;;) { 
+    if (list) {
+      val a = car(list);
+      if (nullp(a)) {
+        list = cdr(list);
+      } else if (atom(a)) {
+        return list;
+      } else do {
+        push(cdr(list), escape);
+        list = a;
+        a = car(list);
+      } while (consp(a));
+      return list;
+    } else if (*escape) {
+      list = pop(escape);
+    } else {
+      return nil;
+    }
+  }
+}
+
+static val lazy_flatten_func(val env, val lcons)
+{
+  cons_bind (list, escape, env);
+  val atom = car(list);
+  val next = lazy_flatten_scan(cdr(list), &escape);
+
+  rplaca(lcons, atom);
+  rplaca(env, next);
+  rplacd(env, escape);
+
+  if (next)
+    rplacd(lcons, make_lazy_cons(lcons_fun(lcons)));
+
+  return nil;
+}
+
+val lazy_flatten(val list)
+{
+  val escape = nil;
+  val next = lazy_flatten_scan(list, &escape);
+
+  if (!next)
+    return nil;
+
+  return make_lazy_cons(func_f1(cons(next, escape), lazy_flatten_func));
+}
+
 cnum c_num(val num);
 
 val eql(val left, val right)
diff --git a/lib.h b/lib.h
index 4bef95a0..6b3bf0a9 100644
--- a/lib.h
+++ b/lib.h
@@ -333,6 +333,7 @@ val nappend2(val list1, val list2);
 val appendv(val lists);
 val ldiff(val list1, val list2);
 val flatten(val list);
+val lazy_flatten(val list);
 val memq(val obj, val list);
 val memql(val obj, val list);
 val memqual(val obj, val list);
diff --git a/match.c b/match.c
index 7556494f..715bf112 100644
--- a/match.c
+++ b/match.c
@@ -1974,7 +1974,7 @@ static val v_next(match_files_ctx *c)
         {
           cons_bind (new_bindings, success,
                      match_files(mf_file_data(*c, lit("var"),
-                                 flatten(cdr(existing)), num(1))));
+                                 lazy_flatten(cdr(existing)), num(1))));
 
           if (success)
             return cons(new_bindings,
diff --git a/txr.1 b/txr.1
index d0cdcdf4..58112083 100644
--- a/txr.1
+++ b/txr.1
@@ -5606,7 +5606,7 @@ Examples:
   (ldiff a b))
 -> (1)
 
-.SS Function flatten
+.SS Functions flatten, lazy-flatten
 
 .TP
 Syntax:
@@ -5617,7 +5617,11 @@ Syntax:
 Description:
 
 The flatten function produces a list whose elements are all of the non-nil
-atoms contained in the structure of <list>.
+atoms contained in the structure of <list>. The lazy-flatten function
+works like flatten except that flatten creates and returns a complete
+flattened list, whereas lazy-flatten produces a lazy list which is
+instantiated on demand. This is particularly useful when the input
+structure is itself lazy.
 
 .TP
 Examples: