From a82a0b4aa32dc54b5ee590e9b87e9ad635b12ecc Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sat, 14 Apr 2012 14:11:25 -0700 Subject: * 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. --- lib.c | 42 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) (limited to 'lib.c') diff --git a/lib.c b/lib.c index e0c73dbb..7e42361a 100644 --- a/lib.c +++ b/lib.c @@ -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; -- cgit v1.2.3