lib: new function separate.

* lib.c (separate): New function.

* lib.h (separate): Declared.

* eval.c (eval_init): Register separate intrinsic.

* txr.1: Documented.

* stdlib/doc-syms.tl: Updated.

5 files changed, 131 insertions, 5 deletions

diff --git a/eval.c b/eval.c
index be559e6f..d51eb5d3 100644
--- a/eval.c
+++ b/eval.c
@@ -6867,6 +6867,7 @@ void eval_init(void)
   reg_fun(intern(lit("keepql"), user_package), func_n3o(keepql, 2));
   reg_fun(intern(lit("keepqual"), user_package), func_n3o(keepqual, 2));
   reg_fun(intern(lit("keep-if"), user_package), func_n3o(keep_if, 2));
+  reg_fun(intern(lit("separate"), user_package), func_n3o(separate, 2));
   reg_fun(intern(lit("remq*"), user_package), func_n2(remq_lazy));
   reg_fun(intern(lit("remql*"), user_package), func_n2(remql_lazy));
   reg_fun(intern(lit("remqual*"), user_package), func_n2(remqual_lazy));
diff --git a/lib.c b/lib.c
index 78b50751..006036a9 100644
--- a/lib.c
+++ b/lib.c
@@ -2927,6 +2927,89 @@ val keep_if(val pred, val seq, val keyfun)
   return remove_if(notf(pred), seq, keyfun);
 }
 
+val separate(val pred, val seq_in, val keyfun_in)
+{
+  val self = lit("separate");
+  val keyfun = default_null_arg(keyfun_in);
+
+  switch (type(seq_in)) {
+  case NIL:
+    return nil;
+  case CONS:
+  case LCONS:
+  case COBJ:
+    {
+      list_collect_decl (yea, yptail);
+      list_collect_decl (nay, nptail);
+      val list = seq_in;
+      val lastdiff = list;
+      val was_yea = nil; /* Initialize to nil to silence compiler warning. */
+
+      gc_hint(list);
+
+      for (; list; list = cdr(list)) {
+        val elem = car(list);
+        val key = keyfun ? funcall1(keyfun, elem) : elem;
+        val is_yea = if3(funcall1(pred, key), t, nil);
+
+        if (list != seq_in && neq(is_yea, was_yea)) {
+          if (was_yea)
+            yptail = list_collect_nconc(yptail, ldiff(lastdiff, list));
+          else
+            nptail = list_collect_nconc(nptail, ldiff(lastdiff, list));
+
+          lastdiff = list;
+        }
+
+        was_yea = is_yea;
+      }
+
+      if (was_yea)
+        yptail = list_collect_nconc(yptail, lastdiff);
+      else
+        nptail = list_collect_nconc(nptail, lastdiff);
+
+      return cons(yea, cons(nay, nil));
+    }
+  case LIT:
+  case STR:
+  case LSTR:
+    {
+      val yea = mkustring(zero);
+      val nay = mkustring(zero);
+      val str = seq_in;
+      cnum len = c_fixnum(length_str(str), self), i;
+
+      for (i = 0; i < len; i++) {
+        val elem = chr_str(str, num_fast(i));
+        val key = keyfun ? funcall1(keyfun, elem) : elem;
+
+        string_extend(funcall1(pred, key) ? yea : nay, elem);
+      }
+
+      return cons(yea, cons(nay, nil));
+    }
+  case VEC:
+    {
+      val yea = vector(zero, nil);
+      val nay = vector(zero, nil);
+      val vec = seq_in;
+      cnum len = c_fixnum(length_vec(vec), self), i;
+
+      for (i = 0; i < len; i++) {
+        val elem = vecref(vec, num_fast(i));
+        val key = keyfun ? funcall1(keyfun, elem) : elem;
+
+        vec_push(funcall1(pred, key) ? yea : nay, elem);
+      }
+
+      return cons(yea, cons(nay, nil));
+    }
+  default:
+    uw_throwf(error_s, lit("~a: ~s isn't a sequence"), self, seq_in, nao);
+  }
+}
+
 static val rem_lazy_rec(val obj, val list, val env, val func);
 
 static val rem_lazy_func(val env, val lcons)
diff --git a/lib.h b/lib.h
index a306830b..de4f858a 100644
--- a/lib.h
+++ b/lib.h
@@ -686,6 +686,7 @@ val keepq(val obj, val seq, val keyfun);
 val keepql(val obj, val seq, val keyfun);
 val keepqual(val obj, val seq, val keyfun);
 val keep_if(val pred, val seq, val keyfun);
+val separate(val pred, val seq, val keyfun);
 val remq_lazy(val obj, val list);
 val remql_lazy(val obj, val list);
 val remqual_lazy(val obj, val list);
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl
index e1a5d5a0..b2bfa33e 100644
--- a/stdlib/doc-syms.tl
+++ b/stdlib/doc-syms.tl
@@ -1036,8 +1036,8 @@
       ("join-with" "N-00B6ACE3")
       ("json" "N-0222106A")
       ("juxt" "N-0106CD7F")
-      ("keep-if" "N-01413802")
-      ("keep-if*" "N-01413802")
+      ("keep-if" "N-0159C541")
+      ("keep-if*" "N-0159C541")
       ("keep-match-products" "N-01A846D2")
       ("keep-matches" "N-01A846D2")
       ("keepq" "N-00583609")
@@ -1513,8 +1513,8 @@
       ("relate" "N-032DBF7E")
       ("release-deferred-warnings" "N-012F0BE9")
       ("remhash" "N-0029C57A")
-      ("remove-if" "N-01413802")
-      ("remove-if*" "N-01413802")
+      ("remove-if" "N-0159C541")
+      ("remove-if*" "N-0159C541")
       ("remove-path" "N-014AF3F7")
       ("remove-path-rec" "N-03E81B3A")
       ("remq" "N-000ECD82")
@@ -1608,6 +1608,7 @@
       ("seek-stream" "N-031B5075")
       ("select" "N-031D7F72")
       ("self-path" "N-03561A65")
+      ("separate" "N-0159C541")
       ("seq-begin" "N-0068A845")
       ("seq-next" "N-02E3D643")
       ("seq-reset" "N-01CA6912")
diff --git a/txr.1 b/txr.1
index 47d41801..8fc4a3f5 100644
--- a/txr.1
+++ b/txr.1
@@ -32451,10 +32451,11 @@ is omitted, then each element itself of
 is compared to
 .metn object .
 
-.coNP Functions @, remove-if @, keep-if @ remove-if* and @ keep-if*
+.coNP Functions @, remove-if @, keep-if @, separate @ remove-if* and @ keep-if*
 .synb
 .mets (remove-if < predicate-function < sequence <> [ key-function ])
 .mets (keep-if < predicate-function < sequence <> [ key-function ])
+.mets (separate < predicate-function < sequence <> [ key-function ])
 .mets (remove-if* < predicate-function < sequence <> [ key-function ])
 .mets (keep-if* < predicate-function < sequence <> [ key-function ])
 .syne
@@ -32497,6 +32498,45 @@ will delete, and removes those that
 will preserve.
 
 The
+.code separate
+function combines
+.code keep-if
+and
+.code remove-if
+into one,
+returning a list of two elements whose
+.code car
+and
+.code cadr
+are the result of calling
+.code keep-if
+and
+.codn remove-if ,
+respectively,
+on
+.meta sequence
+(with the
+.meta predicate-function
+and
+.meta key-function
+arguments passed through).
+One of the two elements may share substructure with the input sequence,
+and may even be the same sequence object if all items are either kept or
+removed (in which case the other element will be
+.codn nil ).
+
+Note: the
+.code separate
+function may be understood in terms of the following reference implementation:
+
+.verb
+  (defun separate (pred seq : (keyfun :))
+    [(juxt (op keep-if pred @1 keyfun)
+           (op remove-if pred @1 keyfun))
+     seq])
+.brev
+
+The
 .code remove-if*
 and
 .code keep-if*