* eval.c (eval_init): Register intrinsic partition function.

* lib.c (partition_func): New static function.
(partition): New function.

* lib.h (partition): Declared.

* txr.1: Documented partition.

5 files changed, 110 insertions, 0 deletions

diff --git a/ChangeLog b/ChangeLog
index 145622e3..62533c85 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,16 @@
 2014-09-09  Kaz Kylheku  <kaz@kylheku.com>
 
+	* eval.c (eval_init): Register intrinsic partition function.
+
+	* lib.c (partition_func): New static function.
+	(partition): New function.
+
+	* lib.h (partition): Declared.
+
+	* txr.1: Documented partition.
+
+2014-09-09  Kaz Kylheku  <kaz@kylheku.com>
+
 	* txr.c (help): Revised help text.
 
 2014-09-08  Kaz Kylheku  <kaz@kylheku.com>
diff --git a/eval.c b/eval.c
index a3272d6a..1cfb10f2 100644
--- a/eval.c
+++ b/eval.c
@@ -3654,6 +3654,7 @@ void eval_init(void)
   reg_fun(intern(lit("flatten*"), user_package), func_n1(lazy_flatten));
   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(memq_s, func_n2(memq));
   reg_fun(memql_s, func_n2(memql));
   reg_fun(memqual_s, func_n2(memqual));
diff --git a/lib.c b/lib.c
index 2b742192..493416fb 100644
--- a/lib.c
+++ b/lib.c
@@ -1431,6 +1431,61 @@ val partition_by(val func, val seq)
                                 partition_by_func));
 }
 
+static val partition_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 (le(index_rebased, zero)) {
+        continue;
+      } else {
+        val first = sub(seq, zero, index_rebased);
+        val rest = nullify(sub(seq, index_rebased, t));
+
+        rplaca(env, rest);
+        rplaca(indices_base, indices);
+        rplacd(indices_base, index);
+
+        if (rest)
+          rplacd(lcons, make_lazy_cons(lcons_fun(lcons)));
+
+        rplaca(lcons, first);
+      }
+    } else {
+      rplaca(lcons, seq);
+    }
+    break;
+  }
+
+  return nil;
+}
+
+val partition(val seq, val indices)
+{
+  seq = nullify(seq);
+  indices = nullify(indices);
+
+  if (!seq)
+    return nil;
+
+  if (!indices)
+    return cons(seq, nil);
+
+  if (functionp(indices))
+    indices = funcall1(indices, seq);
+
+  if (atom(indices))
+    indices = cons(indices, nil);
+
+  return make_lazy_cons(func_f1(cons(seq, cons(indices, zero)),
+                                partition_func));
+}
+
 cnum c_num(val num);
 
 val eql(val left, val right)
diff --git a/lib.h b/lib.h
index ae173621..63e72c3c 100644
--- a/lib.h
+++ b/lib.h
@@ -445,6 +445,7 @@ val flatten(val list);
 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 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 6d44f3fe..fddca88a 100644
--- a/txr.1
+++ b/txr.1
@@ -8034,6 +8034,48 @@ returned which contains those elements of <object> whose keys appear
 in <index-list>. All of <index-list> is processed, even if it contains
 keys which are not in <object>.
 
+.SS Funtion partition
+
+.TP
+Syntax:
+
+  (partition <sequence> {<index-list> | <index> | <function>})
+
+.TP
+Description:
+
+If <sequence> is empty, then partition returns an empty list, and the
+second argument is ignored; if it is <function>, it is not called.
+
+Otherwise, partition-by returns a lazy list of partitions of the sequence
+<sequence>.   Partitions are consecutive, non-empty sub-strings of <sequence>,
+of the same kind as <sequence>.
+
+If the second argument is of the form <index-list>, it is a sequence of
+strictly increasing, positive integers. First, any leading zeros in this sequence
+are dropped. The partition function then divides <sequence> according to the
+indices in index list. The first partition begins with the first element of
+<sequence>. The second partition begins at the first position in <index-list>,
+and so on. Indices beyond the length of the sequence are ignored.
+
+If <index-list> is empty then a one-element list containing the entire
+<sequence> is returned.
+
+If the second argument is a function, then this function is applied
+to <sequence>, and the return value of this call is then used in place of the
+second argument, which must be an <index> or <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 <index-list> of one element.
+
+.TP
+Examples:
+
+  (partition '(1 2 3) 1) -> ((1) (2 3))
+
+  ;; split the string where there is a "b"
+  (partition "abcbcbd" (op where @1 (op eql #\eb))) -> ("a" "bc" "bc" "bd")
+
 .SS Function tree-find
 
 .TP