New function, split*.

* eval.c (eval_init): Register split*.

* lib.c (split_star_func): New static function.
(partition_split_common): Take pointer-to-function argument
instead of boolean. Hoist this C function into the lazy cons.
(partition): Pass pointer to partition_func ito
partition_split_common, intsead of a flag requesting the use
of partition_func.
(split): Pass apointer to split_func into
partition_split_common.
(split_star): New function.

* lib.h (split_star): Declared.

* txr.1: Documented split*.

4 files changed, 63 insertions, 8 deletions

diff --git a/eval.c b/eval.c
index 34d73304..654fe8ae 100644
--- a/eval.c
+++ b/eval.c
@@ -4733,6 +4733,7 @@ void eval_init(void)
   reg_fun(intern(lit("partition-by"), user_package), func_n2(partition_by));
   reg_fun(intern(lit("partition"), user_package), func_n2(partition));
   reg_fun(intern(lit("split"), user_package), func_n2(split));
+  reg_fun(intern(lit("split*"), user_package), func_n2(split_star));
   reg_fun(intern(lit("partition*"), user_package), func_n2(partition_star));
   reg_fun(memq_s, func_n2(memq));
   reg_fun(memql_s, func_n2(memql));
diff --git a/lib.c b/lib.c
index 0cff2bb5..e6aa748e 100644
--- a/lib.c
+++ b/lib.c
@@ -1929,7 +1929,44 @@ static val split_func(val env, val lcons)
   return nil;
 }
 
-static val partition_split_common(val seq, val indices, val partition_p)
+static val split_star_func(val env, val lcons)
+{
+  cons_bind (seq, indices_base, env);
+  cons_bind (indices, base, indices_base);
+
+  for (;;) {
+    if (indices) {
+      val index = pop(&indices);
+      val index_rebased = minus(index, base);
+
+      if (lt(index_rebased, zero)) {
+        continue;
+      } else {
+        val first = sub(seq, zero, index_rebased);
+        val rsub = sub(seq, succ(index_rebased), t);
+        val rest = nullify(rsub);
+
+        rplaca(env, rest);
+        rplaca(indices_base, indices);
+        rplacd(indices_base, succ(index));
+
+        rplacd(lcons, if3(rest,
+                          make_lazy_cons(lcons_fun(lcons)),
+                          cons(rsub, nil)));
+
+        rplaca(lcons, first);
+      }
+    } else {
+      rplaca(lcons, seq);
+    }
+    break;
+  }
+
+  return nil;
+}
+
+static val partition_split_common(val seq, val indices,
+                                  val (*split_fptr)(val env, val lcons))
 {
   seq = nullify(seq);
 
@@ -1947,18 +1984,22 @@ static val partition_split_common(val seq, val indices, val partition_p)
   if (!seqp(indices))
     indices = cons(indices, nil);
 
-  return make_lazy_cons(func_f1(cons(seq, cons(indices, zero)),
-                                if3(partition_p, partition_func, split_func)));
+  return make_lazy_cons(func_f1(cons(seq, cons(indices, zero)), split_fptr));
 }
 
 val partition(val seq, val indices)
 {
-  return partition_split_common(seq, indices, t);
+  return partition_split_common(seq, indices, partition_func);
 }
 
 val split(val seq, val indices)
 {
-  return partition_split_common(seq, indices, nil);
+  return partition_split_common(seq, indices, split_func);
+}
+
+val split_star(val seq, val indices)
+{
+  return partition_split_common(seq, indices, split_star_func);
 }
 
 static val partition_star_func(val env, val lcons)
diff --git a/lib.h b/lib.h
index c07bc863..8b2b700d 100644
--- a/lib.h
+++ b/lib.h
@@ -530,6 +530,7 @@ val partition_by(val func, val seq);
 val partition(val seq, val indices);
 val split(val seq, val indices);
 val partition_star(val seq, val indices);
+val split_star(val seq, val indices);
 val memq(val obj, val list);
 val memql(val obj, val list);
 val memqual(val obj, val list);
diff --git a/txr.1 b/txr.1
index 6df2f322..5f8a4c3b 100644
--- a/txr.1
+++ b/txr.1
@@ -21889,17 +21889,20 @@ of one element.
                                                     "bc" "bd")
 .cble
 
-.coNP Function @ split
+.coNP Functions @ split and @ split*
 .synb
 .mets (split < sequence >> { index-list >> | index <> | function })
+.mets (split* < sequence >> { index-list >> | index <> | function })
 .syne
 .desc
 
 If
 .meta sequence
-is empty, then
+is empty, then both
 .code split
-returns an empty list, and the
+and
+.code split*
+return an empty list, and the
 second argument is ignored; if it is
 .metn function ,
 it is not called.
@@ -21917,6 +21920,12 @@ a sequence that is
 .code equal
 to the original sequence.
 
+The
+.code split*
+function differs from
+.code split
+in that the elements indicated by the split indices are removed.
+
 If the second argument is of the form
 .metn index-list ,
 it shall be a sequence of increasing integers.
@@ -21978,6 +21987,9 @@ of one element.
 
   ;; triple split at makes two additional empty pieces
   (split "abc" '(1 1 1)) -> ("a" "" "" "bc")
+
+  (split* "abc" 0) -> ("" "bc") ;; "a" is removed
+  (split* "abc" '(0 1 2)) -> ("" "" "" "") ;; all characters removed
 .cble
 
 .coNP Function @ partition*