diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2014-09-09 07:49:11 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2014-09-09 07:49:11 -0700 |
commit | 86f375c1b521357cffb9d8411abc031da8279acb (patch) | |
tree | cf4e8af1c83d1d0f38af4af3494d38d44f6fb664 | |
parent | 5d7a23ac901cd067354dfde1f833140e6e18e3f5 (diff) | |
download | txr-86f375c1b521357cffb9d8411abc031da8279acb.tar.gz txr-86f375c1b521357cffb9d8411abc031da8279acb.tar.bz2 txr-86f375c1b521357cffb9d8411abc031da8279acb.zip |
* eval.c (eval_init): Register intrinsic partition* function.
* lib.c (partition_star_func): New static function.
(partition_star): New function.
* lib.h (partition_star): Declared.
* txr.1: Documented partition*.
-rw-r--r-- | ChangeLog | 11 | ||||
-rw-r--r-- | eval.c | 1 | ||||
-rw-r--r-- | lib.c | 77 | ||||
-rw-r--r-- | lib.h | 1 | ||||
-rw-r--r-- | txr.1 | 41 |
5 files changed, 131 insertions, 0 deletions
@@ -1,5 +1,16 @@ 2014-09-09 Kaz Kylheku <kaz@kylheku.com> + * eval.c (eval_init): Register intrinsic partition* function. + + * lib.c (partition_star_func): New static function. + (partition_star): New function. + + * lib.h (partition_star): Declared. + + * txr.1: Documented partition*. + +2014-09-09 Kaz Kylheku <kaz@kylheku.com> + * eval.c (eval_init): Register intrinsic partition function. * lib.c (partition_func): New static function. @@ -3655,6 +3655,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("partition*"), user_package), func_n2(partition_star)); reg_fun(memq_s, func_n2(memq)); reg_fun(memql_s, func_n2(memql)); reg_fun(memqual_s, func_n2(memqual)); @@ -1486,6 +1486,83 @@ val partition(val seq, val indices) partition_func)); } +static val partition_star_func(val env, val lcons) +{ + for (;;) { + cons_bind (seq, indices_base, env); + cons_bind (indices, base, indices_base); + + if (indices) { + val index = pop(&indices); + val index_rebased = minus(index, base); + val first = nullify(sub(seq, zero, index_rebased)); + + seq = nullify(sub(seq, plus(index_rebased, one), t)); + + rplaca(env, seq); + rplaca(indices_base, indices); + rplacd(indices_base, base = plus(index, one)); + + if (!first) + continue; + + rplaca(lcons, first); + + while (seq && eql(car(indices), base)) { + seq = nullify(cdr(seq)); + base = plus(base, one); + pop(&indices); + } + + rplaca(indices_base, indices); + rplacd(indices_base, base); + + if (seq) + rplacd(lcons, make_lazy_cons(lcons_fun(lcons))); + } else { + rplaca(lcons, seq); + } + + break; + } + + return nil; +} + +val partition_star(val seq, val indices) +{ + val base = zero; + seq = nullify(seq); + indices = nullify(indices); + + if (!seq) + return nil; + + if (!indices) + return cons(seq, nil); + + if (functionp(indices)) + indices = funcall1(indices, seq); + + if (indices == zero) + return nullify(rest(seq)); + + if (atom(indices)) { + indices = cons(indices, nil); + } else { + while (eql(car(indices), base)) { + seq = nullify(cdr(seq)); + if (!seq) + return nil; + base = plus(base, one); + pop(&indices); + } + } + + return make_lazy_cons(func_f1(cons(seq, cons(indices, base)), + partition_star_func)); +} + cnum c_num(val num); val eql(val left, val right) @@ -446,6 +446,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 partition_star(val seq, val indices); val memq(val obj, val list); val memql(val obj, val list); val memqual(val obj, val list); @@ -8076,6 +8076,47 @@ Examples: ;; split the string where there is a "b" (partition "abcbcbd" (op where @1 (op eql #\eb))) -> ("a" "bc" "bc" "bd") +.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. + +If the second argument is of the form <index-list>, which is a sequence +of strictly increasing non-negative integers, then partition* produces +lazy list of pieces taken from <sequence>. The pieces are formed by +deleting from <sequence> the elements at the positions given +in <index-list>. The pieces are the non-empty sub-strings between +the deleted elements. + +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 4 5) '(0 2 4)) -> ((1) (3) (5)) + + (partition* "abcd" '(0 3)) -> "bc" + + (partition* "abcd" '(0 1 2 3)) -> nil + + .SS Function tree-find .TP |