From 286bb507a316acefcecc87865f3a152c403ea8b3 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 1 Sep 2020 06:40:36 -0700
Subject: New function: reject.

* eval.c (eva_init): Register reject intrinsic.

* lib.c (appendl): New static function.
(reject): New function.

* lib.h (reject): Declared.

* txr.1: Documented.
---
 eval.c |  1 +
 lib.c  | 45 ++++++++++++++++++++++++++++++++++++++++++
 lib.h  |  1 +
 txr.1  | 70 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 117 insertions(+)

diff --git a/eval.c b/eval.c
index 1091432d..de2acf92 100644
--- a/eval.c
+++ b/eval.c
@@ -6963,6 +6963,7 @@ void eval_init(void)
   reg_fun(intern(lit("contains"), user_package), func_n4o(contains, 2));
   reg_fun(intern(lit("where"), user_package), func_n2(where));
   reg_fun(intern(lit("select"), user_package), func_n2(sel));
+  reg_fun(intern(lit("reject"), user_package), func_n2(reject));
   reg_fun(intern(lit("relate"), user_package), func_n3o(relate, 2));
   reg_fun(intern(lit("seq-begin"), user_package), func_n1(seq_begin));
   reg_fun(intern(lit("seq-next"), user_package), func_n2(seq_next));
diff --git a/lib.c b/lib.c
index cbf9cc2a..0f7595c4 100644
--- a/lib.c
+++ b/lib.c
@@ -2071,6 +2071,12 @@ val appendv(struct args *lists)
   return out;
 }
 
+static val appendl(val lists)
+{
+  args_decl_list(args, ARGS_MIN, lists);
+  return appendv(args);
+}
+
 val nappend2(val list1, val list2)
 {
   list_collect_decl (out, ptail);
@@ -11717,6 +11723,45 @@ val sel(val seq, val where_in)
   return make_like(out, seq);
 }
 
+val reject(val seq, val where_in)
+{
+  val self = lit("reject");
+  seq_info_t si = seq_info(seq);
+  val (*appendfn)(val) = lazy_appendl;
+
+  switch (si.kind) {
+  case SEQ_NIL:
+    return nil;
+  case SEQ_HASHLIKE:
+    {
+      seq_iter_t wh_iter;
+      val wh;
+      val newhash = copy_hash(si.obj);
+      val where = if3(functionp(where_in),
+                      funcall1(where_in, seq),
+                      where_in);
+      seq_iter_init(self, &wh_iter, where);
+
+      while (seq_get(&wh_iter, &wh))
+        remhash(newhash, wh);
+
+      return newhash;
+    }
+  case SEQ_VECLIKE:
+    appendfn = appendl;
+    /* fallthrough */
+  case SEQ_LISTLIKE:
+    {
+      val list = appendfn(split_star(seq, where_in));
+      return make_like(list, seq);
+    }
+    break;
+  case SEQ_NOTSEQ:
+  default:
+    type_mismatch(lit("~a: ~s is not a sequence"), self, seq, nao);
+  }
+}
+
 static val do_relate(val env, val arg)
 {
   cons_bind (dom, rng, env);
diff --git a/lib.h b/lib.h
index e74ed15f..c6f90a58 100644
--- a/lib.h
+++ b/lib.h
@@ -1185,6 +1185,7 @@ val contains(val key, val seq, val testfun, val keyfun);
 val rsearch(val seq, val key, val from, val to);
 val where(val func, val seq);
 val sel(val seq, val where);
+val reject(val seq, val where);
 val relate(val domain_seq, val range_seq, val dfl_val);
 val rcons(val from, val to);
 val rangep(val obj);
diff --git a/txr.1 b/txr.1
index 84d2512f..a44fb8c5 100644
--- a/txr.1
+++ b/txr.1
@@ -31826,6 +31826,76 @@ from the input sequence, and a new
 is returned whose storage is initialized by converting the extracted
 values back to the foreign representation.
 
+.coNP Function @ reject
+.synb
+.mets (reject < sequence >> { index-list | << function })
+.syne
+.desc
+The
+.code reject
+function returns a sequence, of the same kind as
+.metn sequence ,
+which consists of all those elements of
+.meta sequence
+which are not identified by the indices in
+.metn index-list ,
+which may be a list or a vector.
+
+If
+.meta function
+is given instead of
+.metn index-list ,
+then
+.meta function
+is invoked with
+.meta sequence
+as its argument. The return value is then taken as
+if it were the
+.meta index-list
+argument .
+
+If
+.code sequence
+is a hash, then
+.meta index-list
+represents a list of keys. The
+.code reject
+function returns a duplicate of the hash, in which
+the keys specified in
+.meta index-list
+do not appear.
+
+Otherwise if
+.meta sequence
+is a vector-like sequence, then the behavior of
+.code reject
+may be understood by the following equivalence:
+
+.verb
+  (reject seq idx)  -->  (make-like
+                           [apply append (split* seq idx)]
+                           seq)
+.brev
+
+where it is to be understood that
+.meta seq
+is evaluated only once.
+
+If
+.meta sequence
+is a list, then, similarly, the following equivalence applies:
+
+.verb
+  (reject seq idx)  -->  (make-like
+                           [apply append* (split* seq idx)]
+                           seq)
+.brev
+
+The input sequence is split into pieces at the indicated indices, such that
+the elements at the indices are removed and do not appear in the pieces. The
+pieces are then appended together in order, and the resulting list is coerced
+into the same type of sequence as the input sequence.
+
 .coNP Function @ relate
 .synb
 .mets (relate < domain-seq < range-seq <> [ default-val ])
-- 
cgit v1.2.3