New keepq, keepql and keepqual functions.

* eval.c (eval_init): Register keepq, keepql and keepqual
intrinsic functions.

* lib.c (keepq, keepql, keepqual): New functions.

* lib.h (keepq, keepql, keepqual): Declared.

1 files changed, 61 insertions, 0 deletions

diff --git a/lib.c b/lib.c
index 1ed27766..0134d477 100644
--- a/lib.c
+++ b/lib.c
@@ -1554,6 +1554,67 @@ val remove_if(val pred, val list_orig, val key)
   return make_like(out, list_orig);
 }
 
+val keepq(val obj, val list_orig, val key)
+{
+  list_collect_decl (out, ptail);
+  val list = tolist(list_orig);
+  val lastmatch = cons(nil, list);
+
+  key = default_arg(key, identity_f);
+
+  gc_hint(list);
+
+  for (; list; list = cdr(list)) {
+    if (funcall1(key, car(list)) != obj) {
+      ptail = list_collect_nconc(ptail, ldiff(cdr(lastmatch), list));
+      lastmatch = list;
+    }
+  }
+  ptail = list_collect_nconc(ptail, cdr(lastmatch));
+  return make_like(out, list_orig);
+}
+
+val keepql(val obj, val list_orig, val key)
+{
+  list_collect_decl (out, ptail);
+  val list = tolist(list_orig);
+  val lastmatch = cons(nil, list);
+
+  key = default_arg(key, identity_f);
+
+  gc_hint(list);
+
+  for (; list; list = cdr(list)) {
+    if (!eql(funcall1(key, car(list)), obj)) {
+      ptail = list_collect_nconc(ptail, ldiff(cdr(lastmatch), list));
+      ptail = list_collect_nconc(ptail, ldiff(cdr(lastmatch), list));
+      lastmatch = list;
+    }
+  }
+  ptail = list_collect_nconc(ptail, cdr(lastmatch));
+  return make_like(out, list_orig);
+}
+
+val keepqual(val obj, val list_orig, val key)
+{
+  list_collect_decl (out, ptail);
+  val list = tolist(list_orig);
+  val lastmatch = cons(nil, list);
+
+  key = default_arg(key, identity_f);
+
+  gc_hint(list);
+
+  for (; list; list = cdr(list)) {
+    if (!equal(funcall1(key, car(list)), obj)) {
+      ptail = list_collect_nconc(ptail, ldiff(cdr(lastmatch), list));
+      lastmatch = list;
+    }
+  }
+  ptail = list_collect_nconc(ptail, cdr(lastmatch));
+  return make_like(out, list_orig);
+}
+
 val keep_if(val pred, val list_orig, val key)
 {
   list_collect_decl (out, ptail);