diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | eval.c | 2 | ||||
| -rw-r--r-- | lib.c | 42 | ||||
| -rw-r--r-- | lib.h | 2 | ||||
| -rw-r--r-- | txr.1 | 43 |
5 files changed, 99 insertions, 0 deletions
@@ -1,3 +1,13 @@ +2012-04-14 Kaz Kylheku <kaz@kylheku.com> + + * eval.c (eval_init): New functions remove-if and keep-if. + + * lib.c (remove_if, keep_if): New functions. + + * lib.h (remove_if, keep_if): Declared. + + * txr.1: Documented. + 2012-04-13 Kaz Kylheku <kaz@kylheku.com> * configure: Restructuring configure script to be able to detect @@ -2175,6 +2175,8 @@ void eval_init(void) reg_fun(intern(lit("remq"), user_package), func_n2(remq)); reg_fun(intern(lit("remql"), user_package), func_n2(remql)); reg_fun(intern(lit("remqual"), user_package), func_n2(remqual)); + reg_fun(intern(lit("remove-if"), user_package), func_n3o(remove_if, 2)); + reg_fun(intern(lit("keep-if"), user_package), func_n3o(keep_if, 2)); reg_fun(intern(lit("tree-find"), user_package), func_n3o(tree_find, 2)); reg_fun(intern(lit("some"), user_package), func_n3o(some_satisfy, 2)); reg_fun(intern(lit("all"), user_package), func_n3o(all_satisfy, 2)); @@ -678,6 +678,48 @@ val remqual(val obj, val list) return out; } +val remove_if(val pred, val list, val key) +{ + list_collect_decl (out, ptail); + val lastmatch = cons(nil, list); + + if (!key) + key = identity_f; + + for (; list; list = cdr(list)) { + val subj = funcall1(key, car(list)); + val satisfies = funcall1(pred, subj); + + if (satisfies) { + list_collect_nconc(ptail, ldiff(cdr(lastmatch), list)); + lastmatch = list; + } + } + list_collect_nconc(ptail, cdr(lastmatch)); + return out; +} + +val keep_if(val pred, val list, val key) +{ + list_collect_decl (out, ptail); + val lastmatch = cons(nil, list); + + if (!key) + key = identity_f; + + for (; list; list = cdr(list)) { + val subj = funcall1(key, car(list)); + val satisfies = funcall1(pred, subj); + + if (!satisfies) { + list_collect_nconc(ptail, ldiff(cdr(lastmatch), list)); + lastmatch = list; + } + } + list_collect_nconc(ptail, cdr(lastmatch)); + return out; +} + val tree_find(val obj, val tree, val testfun) { uses_or2; @@ -384,6 +384,8 @@ val memqual(val obj, val list); val remq(val obj, val list); val remql(val obj, val list); val remqual(val obj, val list); +val remove_if(val pred, val list, val key); +val keep_if(val pred, val list, val key); val tree_find(val obj, val tree, val testfun); val some_satisfy(val list, val pred, val key); val all_satisfy(val list, val pred, val key); @@ -6670,6 +6670,49 @@ The input <list> is unmodified, but the returned list may share substructure with it. If no items are removed, it is possible that the return value is <list> itself. +.SS Function remove-if + +.TP +Syntax: + + (remove-if <predicate-function> <list> : <key-function>) + (keep-if <predicate-function> <list> : <key-function>) + +.TP +Description + +The remove-if function produces a list whose contents are those of +<list> but with those elements removed which satisfy <predicate-function>. +Those elements which are not removed appear in the same order. +The result list may share substructure with the input list, +and may even be the same list object if no items are removed. + +The optional <key-function> specifies how each element from the <list> is +transformed to an argument to <predicate-function>. If this argument is omitted +or specified as nil, then the predicate function is applied to the elements +directly, a behavior which is identical to <key-function> being (fun identity). + +The keep-if function is exactly like remove-if, except the sense of +the predicate is inverted. The function keep-if retains those items +which remove-if will delete, and removes those that remove-if will preserve. + +.TP +Examples: + + ;; remove any element numerically equal to 3. + (remove-if (op = 3) '(1 2 3 4 3.0 5)) -> (1 2 4 5) + + ;; remove those pairs whose first element begins with "abc" + [remove-if (op equal [@1 0..3] "abc") + '(("abcd" 4) ("defg" 5)) + car] + -> (("defg 5)) + + ;; equivalent, without test function + (remove-if (op equal [(car @1) 0..3] "abc") + '(("abcd" 4) ("defg" 5))) + -> (("defg 5)) + .SS Function tree-find .TP |