diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2024-02-09 07:34:15 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2024-02-09 07:34:15 -0800 |
commit | ab58598e62eb7ca718d2ee083c1c2c2ede4d6db3 (patch) | |
tree | 245dd7aa545d26db0d62fefa61de13ff5310ed4c | |
parent | 3fb108272f762a4e3afa3f2f925db03b3128c272 (diff) | |
download | txr-ab58598e62eb7ca718d2ee083c1c2c2ede4d6db3.tar.gz txr-ab58598e62eb7ca718d2ee083c1c2c2ede4d6db3.tar.bz2 txr-ab58598e62eb7ca718d2ee083c1c2c2ede4d6db3.zip |
New function: cons-count.
* eval.c (eval_init): Register cons-count intrinsic.
* lib.c (cons_count_rec): New static function.
(cons_count): New function.
* lib.h (cons_count): Declared.
* tests/012/cons.tl: New tests.
* txr.1: Documented.
-rw-r--r-- | eval.c | 1 | ||||
-rw-r--r-- | lib.c | 19 | ||||
-rw-r--r-- | lib.h | 1 | ||||
-rw-r--r-- | tests/012/cons.tl | 9 | ||||
-rw-r--r-- | txr.1 | 41 |
5 files changed, 71 insertions, 0 deletions
@@ -7364,6 +7364,7 @@ void eval_init(void) reg_fun(intern(lit("countq"), user_package), func_n2(countq)); reg_fun(intern(lit("count-if"), user_package), func_n3o(count_if, 2)); reg_fun(intern(lit("count"), user_package), func_n4o(count, 2)); + reg_fun(intern(lit("cons-count"), user_package), func_n3o(cons_count, 2)); reg_fun(intern(lit("posqual"), user_package), func_n2(posqual)); reg_fun(intern(lit("rposqual"), user_package), func_n2(rposqual)); reg_fun(intern(lit("posql"), user_package), func_n2(posql)); @@ -3596,6 +3596,25 @@ val count(val item, val seq, val testfun_in, val keyfun_in) } +static val cons_count_rec(val item, val tree, val testfun) +{ + val hc = if3(funcall2(testfun, item, tree), one, zero); + + if (consp(tree)) { + val ac = cons_count_rec(item, us_car(tree), testfun); + val dc = cons_count_rec(item, us_cdr(tree), testfun); + + return plus(plus(hc, ac), dc); + } + + return hc; +} + +val cons_count(val item, val tree, val testfun_in) +{ + return cons_count_rec(item, tree, default_arg(testfun_in, equal_f)); +} + val some_satisfy(val seq, val pred_in, val key_in) { val pred = default_arg(pred_in, identity_f); @@ -864,6 +864,7 @@ val countql(val obj, val list); val countq(val obj, val list); val count_if(val pred, val list, val key); val count(val item, val seq, val testfun_in, val keyfun_in); +val cons_count(val item, val tree, val testfun_in); val some_satisfy(val list, val pred, val key); val all_satisfy(val list, val pred, val key); val none_satisfy(val list, val pred, val key); diff --git a/tests/012/cons.tl b/tests/012/cons.tl index d72a5d74..98267290 100644 --- a/tests/012/cons.tl +++ b/tests/012/cons.tl @@ -24,3 +24,12 @@ (cons-find "d" '("a" (("b") . "d") "c")) t (cons-find "d" '("a" . "d")) t (cons-find nil '("a" (("b")) "c")) t) + +(mtest + (cons-count "abc" "abc") 1 + (cons-count "abc" "abc" (fun eq)) 0 + (cons-count "b" '("b" . "b")) 2 + (cons-count "b" '(3 . "b")) 1 + (cons-count "b" '("b" . 3)) 1 + (cons-count "b" '(("b" . "b") ("b" . "b"))) 4 + (cons-count nil '(1 (2 3 (4)))) 3) @@ -36112,6 +36112,47 @@ The function returns the count of the number keys for which .meta predfun returns true. +.coNP Function @ cons-count +.synb +.mets (cons-count < obj < tree <> [ test-function ]) +.syne +.desc +The +.code cons-count +function returns the number of times the object +.meta obj +occurs in the +.code cons +cell structure +.metn tree , +under the equality imposed by the +.metn test-function . + +If the optional +.meta test-function +argument is omitted, it defaults to +.codn equal . + +First, +.meta obj +and +.meta tree +are compared using +.metn test-function . +If they are equal, that counts as one occurrence. + +Then, if +.meta tree +is a +.code cons +cell, the function recurses over the +.code car +and +.code cdr +fields. + +The sum of all these counts is returned. + .coNP Functions @, posq @ posql and @ posqual .synb .mets (posq < object << sequence ) |