From a82a0b4aa32dc54b5ee590e9b87e9ad635b12ecc Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
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