From 34a8e91898d551d036742fd6fb45c57b8e95ad52 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 18 Sep 2015 22:54:47 -0700
Subject: New function: flatcar.

* eval.c (eval_init): Register flatcar intrinsic.

* lib.c (flatcar): New function.

* lib.h (flatcar): Declared.

* txr.1: Documented.
---
 eval.c |  1 +
 lib.c  |  9 +++++++++
 lib.h  |  1 +
 txr.1  | 34 ++++++++++++++++++++++++++++++++++
 4 files changed, 45 insertions(+)

diff --git a/eval.c b/eval.c
index 95eea32f..bea71dd4 100644
--- a/eval.c
+++ b/eval.c
@@ -4211,6 +4211,7 @@ void eval_init(void)
   reg_fun(intern(lit("nthcdr"), user_package), func_n2(nthcdr));
   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("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 b912e9b0..6de77669 100644
--- a/lib.c
+++ b/lib.c
@@ -1512,6 +1512,15 @@ val lazy_flatten(val list)
   }
 }
 
+val flatcar(val tree)
+{
+  if (atom(tree))
+    return cons(tree, nil);
+  if (cdr(tree))
+    return nappend2(flatcar(car(tree)), flatcar(cdr(tree)));
+  return flatcar(car(tree));
+}
+
 static val tuples_func(val env, val lcons)
 {
   list_collect_decl (out, ptail);
diff --git a/lib.h b/lib.h
index 074ccd3c..5742231f 100644
--- a/lib.h
+++ b/lib.h
@@ -496,6 +496,7 @@ val lazy_appendv(struct args *lists);
 val ldiff(val list1, val list2);
 val flatten(val list);
 val lazy_flatten(val list);
+val flatcar(val list);
 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 d4ba9353..a7f3a643 100644
--- a/txr.1
+++ b/txr.1
@@ -14762,6 +14762,40 @@ structure is itself lazy.
   (flatten '(((()) ()))) -> nil
 .cble
 
+.coNP Function @ flatcar
+.synb
+.mets (flatcar << tree )
+.syne
+.desc
+The
+.code flatcar
+function produces a list of all the atoms contained in the
+tree structure
+.metn tree ,
+in the order in which they appear, when the structure is traversed
+left to right.
+
+This list includes those
+.code nil
+atoms which appear in
+.code car
+fields.
+
+The list excludes
+.code nil
+atoms which appear in
+.code cdr
+fields.
+
+.TP* Examples:
+.cblk
+  (flatcar '(1 2 () (3 4))) -> (1 2 nil 3 4)
+
+  (flatcar '(a (b . c) d (e) (((f)) . g) (nil . z) nil . h))
+
+  --> (a b c d e f g nil z nil h)
+.cble
+
 .coNP Function @ tree-find
 .synb
 .mets (tree-find < obj < tree << test-function )
-- 
cgit v1.2.3