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

* lib.c (split_func): New static function.
(partition_split_common): New static function, based on
on contents of partition function.
(partition): Now a wrapper around partition_split_common.
(split): New function.

* lib.h (split): Documented.

* txr.1: Documented split.

5 files changed, 155 insertions, 2 deletions

diff --git a/ChangeLog b/ChangeLog
index 0e196acc..ea191850 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2015-07-21  Kaz Kylheku  <kaz@kylheku.com>
+
+	* eval.c (eval_init): Register new split function.
+
+	* lib.c (split_func): New static function.
+	(partition_split_common): New static function, based on
+	on contents of partition function.
+	(partition): Now a wrapper around partition_split_common.
+	(split): New function.
+
+	* lib.h (split): Documented.
+
+	* txr.1: Documented split.
+
 2015-07-13  Kaz Kylheku  <kaz@kylheku.com>
 
 	* parser.c (open_txr_file): Bugfix: the name of the parsed
diff --git a/eval.c b/eval.c
index 084e556f..e0ef15a8 100644
--- a/eval.c
+++ b/eval.c
@@ -4152,6 +4152,7 @@ void eval_init(void)
   reg_fun(intern(lit("tuples"), user_package), func_n3o(tuples, 2));
   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("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 6e9e2d8e..7ce96c50 100644
--- a/lib.c
+++ b/lib.c
@@ -1525,7 +1525,43 @@ static val partition_func(val env, val lcons)
   return nil;
 }
 
-val partition(val seq, val indices)
+static val split_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, index_rebased, t);
+        val rest = nullify(rsub);
+
+        rplaca(env, rest);
+        rplaca(indices_base, indices);
+        rplacd(indices_base, 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 partition_p)
 {
   seq = nullify(seq);
   indices = nullify(indices);
@@ -1543,7 +1579,17 @@ val partition(val seq, val indices)
     indices = cons(indices, nil);
 
   return make_lazy_cons(func_f1(cons(seq, cons(indices, zero)),
-                                partition_func));
+                                if3(partition_p, partition_func, split_func)));
+}
+
+val partition(val seq, val indices)
+{
+  return partition_split_common(seq, indices, t);
+}
+
+val split(val seq, val indices)
+{
+  return partition_split_common(seq, indices, nil);
 }
 
 static val partition_star_func(val env, val lcons)
diff --git a/lib.h b/lib.h
index cd78205e..9ffdcbc5 100644
--- a/lib.h
+++ b/lib.h
@@ -478,6 +478,7 @@ val lazy_flatten(val list);
 val tuples(val n, val seq, val fill);
 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 memq(val obj, val list);
 val memql(val obj, val list);
diff --git a/txr.1 b/txr.1
index 3d7c961e..c7e68ceb 100644
--- a/txr.1
+++ b/txr.1
@@ -14877,6 +14877,97 @@ of one element.
                                                     "bc" "bd")
 .cble
 
+.coNP Function @ split
+.synb
+.mets (split < sequence >> { index-list >> | index <> | function })
+.syne
+.desc
+
+If
+.meta sequence
+is empty, then
+.code split
+returns an empty list, and the
+second argument is ignored; if it is
+.metn function ,
+it is not called.
+
+Otherwise,
+.code split
+returns a lazy list of pieces of
+.metn sequence :
+consecutive, non-overlapping, possibly empty sub-strings of
+.metn sequence ,
+of the same kind as
+.metn sequence .
+A catenation of these pieces in the order they appear would produce
+a sequence that is
+.code equal
+to the original sequence.
+
+If the second argument is of the form
+.metn index-list ,
+it shall be a sequence of increasing integers.
+The
+.code split
+function divides
+.meta sequence
+according to the
+indices in index list. The first piece always begins with the first
+element of
+.metn sequence .
+Each subsequent piece begins with the position indicated by
+an element of
+.metn index-list .
+Negative indices are ignored. Repeated values give rise to empty
+pieces.
+If
+.meta index-list
+includes index zero,
+then an empty first piece is generated.
+If
+.meta index-list
+includes an index greater than or equal to the length of
+.meta sequence
+(equivalently, an index beyond the last element of the sequence)
+then an additional empty last piece is generated.
+
+If
+.meta index-list
+is empty then a one-element list containing the entire
+.meta sequence
+is returned.
+
+If the second argument is a function, then this function is applied
+to
+.metn sequence ,
+and the return value of this call is then used in place of the
+second argument, which must be an
+.meta index
+or
+.metn index-list .
+
+If the second argument is an atom other than a function, it is assumed to be
+an integer index, and is turned into an
+.meta index-list
+of one element.
+
+.TP* Examples:
+.cblk
+  (split '(1 2 3) 1) -> ((1) (2 3))
+
+  (split "abc" 0) -> ("" "abc")
+  (split "abc" 3) -> ("abc" "")
+  (split "abc" 1) -> ("a" "bc")
+  (split "abc" 0 1 2 3) -> ("" "a" "b" "c" "")
+  (split "abc" 1 2) -> ("a" "b" "c")
+
+  (split "abc" -1 1 2 15) -> ("a" "b" "c")
+
+  ;; triple split at makes two additional empty pieces
+  (split "abc" '(1 1 1)) -> ("a" "" "" "bc")
+.cble
+
 .coNP Function @ partition*
 .synb
 .mets (partition* < sequence >> { index-list >> | index <> | function })