diff options
| -rw-r--r-- | eval.c | 1 | ||||
| -rw-r--r-- | lib.c | 54 | ||||
| -rw-r--r-- | lib.h | 1 | ||||
| -rw-r--r-- | stdlib/doc-syms.tl | 1 | ||||
| -rw-r--r-- | tests/012/seq.tl | 47 | ||||
| -rw-r--r-- | txr.1 | 66 |
6 files changed, 170 insertions, 0 deletions
@@ -6936,6 +6936,7 @@ void eval_init(void) reg_fun(intern(lit("flatcar"), user_package), func_n1(flatcar)); reg_fun(intern(lit("flatcar*"), user_package), func_n1(lazy_flatcar)); reg_fun(intern(lit("tuples"), user_package), func_n3o(tuples, 2)); + reg_fun(intern(lit("tuples*"), user_package), func_n3o(tuples_star, 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)); @@ -3593,6 +3593,60 @@ val tuples(val n, val seq, val fill) return make_lazy_cons_car_cdr(func_f1(n, tuples_func), iter, fill); } +static val tuples_star_func(val tail, val lcons) +{ + us_cons_bind (tuple, iter, lcons); + val item = make_like(tuple, iter); + + if (iter_more(iter)) { + val itemcopy = if3(tuple == item, copy_list(tuple), item); + us_rplaca(lcons, itemcopy); + us_rplacd(tail, cons(iter_item(iter), nil)); + + { + val nxtuple = us_cdr(tuple); + val fun = us_lcons_fun(lcons); + tail = us_cdr(tail); + iter = iter_step(iter); + rcyc_cons(tuple); + us_func_set_env(fun, tail); + us_rplacd(lcons, make_lazy_cons_car_cdr(fun, nxtuple, iter)); + } + } else { + val item = make_like(tuple, iter); + us_rplaca(lcons, item); + us_rplacd(lcons, nil); + } + + return nil; +} + +val tuples_star(val n, val seq, val fill) +{ + val self = lit("tuples*"); + val iter = iter_begin(seq); + cnum i, cn = c_num(n, self); + list_collect_decl (tuple, ptail); + + if (!plusp(n) || !integerp(n)) + uw_throwf(error_s, lit("~a: positive integer required, not ~s"), self, n, nao); + + for (i = 0; i < cn; i++, iter = iter_step(iter)) + { + if (!iter_more(iter)) { + if (missingp(fill)) + return nil; + for (; i < cn; i++) + ptail = list_collect(ptail, fill); + break; + } + + ptail = list_collect(ptail, iter_item(iter)); + } + + return make_lazy_cons_car_cdr(func_f1(lastcons(tuple), tuples_star_func), tuple, iter); +} + static val partition_by_func(val func, val lcons) { list_collect_decl (out, ptail); @@ -677,6 +677,7 @@ val lazy_flatten(val list); val flatcar(val list); val lazy_flatcar(val tree); val tuples(val n, val seq, val fill); +val tuples_star(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); diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl index a2f24324..041314fd 100644 --- a/stdlib/doc-syms.tl +++ b/stdlib/doc-syms.tl @@ -2030,6 +2030,7 @@ ("truncate-stream" "N-009F5B3F") ("try" "N-0328371B") ("tuples" "N-00C801EF") + ("tuples*" "N-036D928C") ("txr-case" "N-03813122") ("txr-exe-path" "N-014C116E") ("txr-if" "N-00355D4E") diff --git a/tests/012/seq.tl b/tests/012/seq.tl index 7e0ae00f..ef5fad7c 100644 --- a/tests/012/seq.tl +++ b/tests/012/seq.tl @@ -262,3 +262,50 @@ (test (take 3 (tuples 3 (range 0))) ((0 1 2) (3 4 5) (6 7 8))) + +(mtest + (tuples* 0 nil) :error + (tuples* 3.5 '(1 2 3)) :error + (tuples* -1 "abc") :error) + +(mtest + (tuples* 1 nil) nil + (tuples* 1 "") nil + (tuples* 1 #()) nil) + +(mtest + (tuples* 1 '(a)) ((a)) + (tuples* 1 "a") ("a") + (tuples* 1 #(1)) (#(1))) + +(mtest + (tuples* 1 '(a b c)) ((a) (b) (c)) + (tuples* 1 "abc") ("a" "b" "c") + (tuples* 1 #(1 2 3)) (#(1) #(2) #(3))) + +(mtest + (tuples* 1 '(a b c) 'd) ((a) (b) (c)) + (tuples* 1 "abc" #\d) ("a" "b" "c") + (tuples* 1 #(1 2 3) 4) (#(1) #(2) #(3))) + +(mtest + (tuples* 2 '(a b c)) ((a b) (b c)) + (tuples* 2 "abc") ("ab" "bc") + (tuples* 2 #(1 2 3)) (#(1 2) #(2 3))) + +(mtest + (tuples* 3 '(a b c)) ((a b c)) + (tuples* 3 "abc") ("abc") + (tuples* 3 #(1 2 3)) (#(1 2 3))) + +(mtest + (tuples* 3 '(a b) 'c) ((a b c)) + (tuples* 3 "a" #\c) ("acc") + (tuples* 3 #() 1) (#(1 1 1))) + +(test + (lforce (tuples* 3 "a" 1)) :error) + +(mtest + (take 3 (tuples* 3 (range 0))) ((0 1 2) (1 2 3) (2 3 4)) + (take 3 (tuples* 3 0)) ((0 1 2) (1 2 3) (2 3 4))) @@ -35883,6 +35883,72 @@ are lists, and not lazy lists. (tuples 3 (list 1 2) #\ez) -> ((1 2 #\ez)) .brev +.coNP Function @ tuples* +.synb +.mets (tuples < length < sequence <> [ fill-value ]) +.syne +.desc +The +.code tuples* +function produces a lazy list of overlapping tuples taken from +.metn sequence . +The length of the tuples is given by the +.meta length +argument. + +The +.meta length +argument must be a positive integer. + +Tuples are subsequences of consecutive items from the input +.metn sequence , +beginning with consecutive elements. The first tuple in the returned list +begins with the fist item of +.metn sequence ; +the second tuple begins with the second item, and so forth. + +The output of the function is a list, but the tuples themselves are sequences +of the same kind as +.metn sequence . +If +.meta sequence +is any kind of list, they +are lists, and not lazy lists. + +If +.meta sequence +is shorter than +.meta length +then it contains no tuples of that length. In this case, if no +.meta fill-value +argument is specified, then the empty list is returned. +In this same situation, if +.meta fill-value +is specified, then a one-element list is returned, consisting of +a tuple of the required length, consisting of the elements from +.meta sequence +followed by repetitions of +.metn fill-value , +which must be of a type suitable as an element of the sequence. +The +.meta fill-value +is otherwise ignored. + +.TP* Examples: + +.verb +.brev + (tuples* 1 "abc") -> ("a" "b" "c") + (tuples* 2 "abc") -> ("ab" "bc") + (tuples* 3 "abc") -> ("abc") + (tuples* 4 "abc") -> nil + (tuples* 4 "abc" #\z) -> ("abcz") + (tuples* 6 "abc" #\z) -> ("abczzz") + (tuples* 6 "abc" 4) -> error + (tuples* 2 '(a b c)) -> ((a b) (b c)) + (take 3 (tuples* 3 0)) -> ((0 1 2) (1 2 3) (2 3 4)) +.brev + .coNP Function @ partition-by .synb .mets (partition-by < function << sequence ) |