summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--eval.c1
-rw-r--r--lib.c51
-rw-r--r--lib.h1
-rw-r--r--txr.118
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*