diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2024-02-09 06:25:11 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2024-02-09 06:25:11 -0800 |
commit | 3fb108272f762a4e3afa3f2f925db03b3128c272 (patch) | |
tree | bcc2195735027e7133ee91249d349dc9be15584c | |
parent | 25bf01699c2af7f8007404d5a62aeb1d64aee7b0 (diff) | |
download | txr-3fb108272f762a4e3afa3f2f925db03b3128c272.tar.gz txr-3fb108272f762a4e3afa3f2f925db03b3128c272.tar.bz2 txr-3fb108272f762a4e3afa3f2f925db03b3128c272.zip |
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.
-rw-r--r-- | eval.c | 13 | ||||
-rw-r--r-- | lib.c | 17 | ||||
-rw-r--r-- | lib.h | 1 | ||||
-rw-r--r-- | tests/012/cons.tl | 26 | ||||
-rw-r--r-- | txr.1 | 48 |
5 files changed, 83 insertions, 22 deletions
@@ -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)); @@ -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"); @@ -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) @@ -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 ) |