From a3c8effa1337c16e9c7832bf1fb4e66f72e5c3c8 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Thu, 15 Sep 2016 06:39:11 -0700
Subject: 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.
---
 lib.c | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 61 insertions(+)

(limited to 'lib.c')

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);
-- 
cgit v1.2.3