From c2032024f5e5121dba9a629f5e6a182ca5d45f16 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 9 Feb 2024 06:25:11 -0800
Subject: New function: cons-find.

* eval.c (cons_find): Static function removed; a new one is
implemented in lib.c.
(eval_init): Register cons-find intrinsic.

* lib.c (cons_find_rec): New static function.
(cons_find): New function.

* lib.h (cons_find): Declared.

* tests/012/cons.tl: New file.

* txr.1: Documented cons-find together with tree-find.
Document that tree-find's test-fun argument is optional,
defaulting to equal.
---
 eval.c            | 13 +------------
 lib.c             | 17 +++++++++++++++++
 lib.h             |  1 +
 tests/012/cons.tl | 26 ++++++++++++++++++++++++++
 txr.1             | 48 ++++++++++++++++++++++++++++++++++++++----------
 5 files changed, 83 insertions(+), 22 deletions(-)
 create mode 100644 tests/012/cons.tl

diff --git a/eval.c b/eval.c
index 828ba73e..52bfe4af 100644
--- a/eval.c
+++ b/eval.c
@@ -4142,18 +4142,6 @@ static val transform_op(val forms, val syms, val rg)
   }
 }
 
-static val cons_find(val obj, val structure, val test)
-{
-  uses_or2;
-
-  if (funcall2(test, obj, structure))
-    return structure;
-  if (atom(structure))
-    return nil;
-  return or2(cons_find(obj, car(structure), test),
-             cons_find(obj, cdr(structure), test));
-}
-
 static val supplement_op_syms(val ssyms)
 {
   list_collect_decl (outsyms, tl);
@@ -7370,6 +7358,7 @@ void eval_init(void)
   reg_fun(intern(lit("remove-if*"), user_package), func_n3o(remove_if_lazy, 2));
   reg_fun(intern(lit("keep-if*"), user_package), func_n3o(keep_if_lazy, 2));
   reg_fun(intern(lit("tree-find"), user_package), func_n3o(tree_find, 2));
+  reg_fun(intern(lit("cons-find"), user_package), func_n3o(cons_find, 2));
   reg_fun(intern(lit("countqual"), user_package), func_n2(countqual));
   reg_fun(intern(lit("countql"), user_package), func_n2(countql));
   reg_fun(intern(lit("countq"), user_package), func_n2(countq));
diff --git a/lib.c b/lib.c
index e1ca5e9e..580ee468 100644
--- a/lib.c
+++ b/lib.c
@@ -3471,6 +3471,23 @@ val tree_find(val obj, val tree, val testfun)
   return nil;
 }
 
+static val cons_find_rec(val obj, val tree, val testfun)
+{
+  uses_or2;
+  if (funcall2(testfun, obj, tree))
+    return t;
+  else if (consp(tree))
+    return or2(cons_find_rec(obj, us_car(tree), testfun),
+               cons_find_rec(obj, us_cdr(tree), testfun));
+  else
+    return nil;
+}
+
+val cons_find(val obj, val tree, val testfun)
+{
+  return cons_find_rec(obj, tree, default_arg(testfun, equal_f));
+}
+
 val countqual(val obj, val seq)
 {
   val self = lit("countqual");
diff --git a/lib.h b/lib.h
index 349d0888..212a03a0 100644
--- a/lib.h
+++ b/lib.h
@@ -858,6 +858,7 @@ val remqual_lazy(val obj, val list);
 val remove_if_lazy(val pred, val list, val key);
 val keep_if_lazy(val pred, val list, val key);
 val tree_find(val obj, val tree, val testfun);
+val cons_find(val obj, val tree, val testfun);
 val countqual(val obj, val list);
 val countql(val obj, val list);
 val countq(val obj, val list);
diff --git a/tests/012/cons.tl b/tests/012/cons.tl
new file mode 100644
index 00000000..d72a5d74
--- /dev/null
+++ b/tests/012/cons.tl
@@ -0,0 +1,26 @@
+(load "../common")
+
+(mtest
+  (tree-find "abc" "abc") t
+  (tree-find "abc" "abc" (fun eq)) nil
+  (tree-find "b" '("a" "b" "c")) t
+  (tree-find "b" '("a" "b" "c") (fun eq)) nil
+  (tree-find "b" '(("b") "a" "c")) t
+  (tree-find "b" '("a" ("b") "c")) t
+  (tree-find "b" '("a" (("b")) "c")) t
+  (tree-find "d" '("a" (("b")) "c")) nil
+  (tree-find nil '("a" (("b")) "c")) nil)
+
+(mtest
+  (cons-find "abc" "abc") t
+  (cons-find "abc" "ABC" (fun eq)) nil
+  (cons-find "b" '("a" "b" "c")) t
+  (cons-find "b" '("a" "b" "c") (fun eq)) nil
+  (cons-find "b" '(("b") "a" "c")) t
+  (cons-find "b" '("a" ("b") "c")) t
+  (cons-find "b" '("a" (("b")) "c")) t
+  (cons-find "d" '("a" (("b")) "c")) nil
+  (cons-find "d" '("a" (("b")) "c" . "d")) t
+  (cons-find "d" '("a" (("b") . "d") "c")) t
+  (cons-find "d" '("a" . "d")) t
+  (cons-find nil '("a" (("b")) "c")) t)
diff --git a/txr.1 b/txr.1
index 3d02e35d..818e4155 100644
--- a/txr.1
+++ b/txr.1
@@ -23313,14 +23313,17 @@ infinite lazy structure.
   --> (a b c d e f g nil z nil h)
 .brev
 
-.coNP Function @ tree-find
+.coNP Functions @ tree-find and @ cons-find
 .synb
-.mets (tree-find < obj < tree << test-function )
+.mets (tree-find < obj < tree <> [ test-function ])
+.mets (cons-find < obj < tree <> [ test-function ])
 .syne
 .desc
 The
 .code tree-find
-function searches
+and
+.code cons-find
+function search
 .meta tree
 for an occurrence of
 .metn obj .
@@ -23338,9 +23341,14 @@ arguments, and has conventions similar to
 .code eql
 or
 .codn equal .
+If an argument is omitted, the default function is
+.codn equal .
 
+Under both
 .code tree-find
-works as follows.  If
+and
+.codn cons-find ,
+if
 .meta tree
 is equivalent to
 .meta obj
@@ -23348,13 +23356,17 @@ under
 .metn test-function ,
 then
 .code t
-is returned to announce a successful finding.
-If this test fails, and
-.meta tree
-is an atom,
+is returned to announce a successful finding. Next, if the mismatched
+.meta obj
+is an atom, both functions return
 .code nil
-is returned immediately to
-indicate that the find failed.  Otherwise,
+to indicate that the search failed.
+
+If none of the above cases occur, the semantics of the functions diverge, as
+follows.
+
+In the case of
+.codn tree-find ,
 .meta tree
 is taken to be a proper list,
 and
@@ -23369,6 +23381,22 @@ which returns a
 .cod2 non- nil
 value.
 
+In the case of
+.codn cons-find ,
+.meta tree
+is taken to be
+.codn cons -cell-based
+tree structure. The
+.code cons-find
+function is recursively applied to the
+.code car
+and
+.code cdr
+fields of
+.metn tree .
+Thus a match may be found in any position in the structure, including the
+dotted position of a list.
+
 .coNP Functions @, memq @ memql and @ memqual
 .synb
 .mets (memq < object << list )
-- 
cgit v1.2.3