diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | eval.c | 121 | ||||
| -rw-r--r-- | txr.1 | 32 |
3 files changed, 159 insertions, 3 deletions
@@ -1,5 +1,14 @@ 2014-02-10 Kaz Kylheku <kaz@kylheku.com> + * eval.c (rcomb_while_fun, rcomb_gen_fun_common, + rcomb_list_gen_fun, rcomb_list, rcomb_vec_gen_fun, rcomb_vec, + rcomb_str_gen_fun, rcomb_str, rcomb): New static functions. + (eval_init): Register rcomb as intrinsic. + + * txr.1: Documented rcomb. + +2014-02-10 Kaz Kylheku <kaz@kylheku.com> + * eval.c (rperm, perm_str): Just in case, return a mutable empty string, rather than null_string, which is a literal. (k_conses, comb_while_fun, comb_gen_fun_common, @@ -2546,6 +2546,126 @@ static val comb(val seq, val k) } } +static val rcomb_while_fun(val state) +{ + return car(state); +} + +static void rcomb_gen_fun_common(val state) +{ + val iter; + val rev = nil; + + for (iter = state; consp(iter); iter = cdr(iter)) { + val curr = first(iter); + val curr_rest = rest(curr); + + push(iter, &rev); + + if (consp(curr_rest)) { + val iter2; + for (iter2 = rev; iter2; iter2 = cdr(iter2)) { + val revit = car(iter2); + *car_l(revit) = curr_rest; + } + return; + } else if (rest(iter)) { + val next = second(iter); + if (curr != next) + *car_l(iter) = rest(next); + } + } + + *car_l(state) = nil; +} + +static val rcomb_list_gen_fun(val state) +{ + val out = nreverse(mapcar(car_f, state)); + rcomb_gen_fun_common(state); + return out; +} + +static val rcomb_list(val list, val k) +{ + val state = nreverse(list_vector(vector(k, list))); + return generate(func_f0(state, rcomb_while_fun), + func_f0(state, rcomb_list_gen_fun)); +} + +static val rcomb_vec_gen_fun(val state) +{ + val nn = length_list(state); + cnum i, n = c_num(nn); + val iter, out = vector(nn, nil); + + for (iter = state, i = n - 1; i >= 0; iter = cdr(iter), i--) + out->v.vec[i] = car(car(iter)); + + rcomb_gen_fun_common(state); + return out; +} + +static val rcomb_vec(val vec, val k) +{ + val state = nreverse(list_vector(vector(k, list_vector(vec)))); + return generate(func_f0(state, rcomb_while_fun), + func_f0(state, rcomb_vec_gen_fun)); +} + +static val rcomb_str_gen_fun(val state) +{ + val nn = length_list(state); + cnum i, n = c_num(nn); + val iter, out = mkustring(nn); + + out->st.str[n] = 0; + + for (iter = state, i = n - 1; i >= 0; iter = cdr(iter), i--) + out->st.str[i] = c_chr(car(car(iter))); + + rcomb_gen_fun_common(state); + return out; +} + +static val rcomb_str(val str, val k) +{ + val state = nreverse(list_vector(vector(k, list_str(str)))); + return generate(func_f0(state, rcomb_while_fun), + func_f0(state, rcomb_str_gen_fun)); +} + +static val rcomb(val seq, val k) +{ + if (!integerp(k)) + type_mismatch(lit("rcomb: ~s is not an integer"), k, nao); + + if (lt(k, zero)) + uw_throwf(numeric_error_s, lit("rcomb: ~s is not a positive integer"), + k, nao); + + switch (type(seq)) { + case CONS: + case LCONS: + case NIL: + if (k == zero) + return cons(nil, nil); + return rcomb_list(seq, k); + case VEC: + if (k == zero) + return cons(vector(zero, nil), nil); + return rcomb_vec(seq, k); + case STR: + case LSTR: + case LIT: + if (k == zero) + return cons(string(L""), nil); + return rcomb_str(seq, k); + default: + type_mismatch(lit("rcomb: ~s is not a sequence"), seq, nao); + } +} + static val errno_wrap(val newval) { val oldval = num(errno); @@ -3141,6 +3261,7 @@ void eval_init(void) reg_fun(intern(lit("rperm"), user_package), func_n2(rperm)); reg_fun(intern(lit("perm"), user_package), func_n2o(perm, 1)); reg_fun(intern(lit("comb"), user_package), func_n2(comb)); + reg_fun(intern(lit("rcomb"), user_package), func_n2(rcomb)); reg_fun(throw_s, func_n1v(uw_throw)); reg_fun(intern(lit("throwf"), user_package), func_n2v(uw_throwfv)); @@ -7936,7 +7936,7 @@ permutations is of zero length. The permutations are lexicographically ordered. -.SS Function comb +.SS Functions comb and rcomb .TP Syntax: @@ -7952,8 +7952,8 @@ length <len> non-repeating combinations formed by taking items taken from element of <seq> more than once. If <seq> contains no duplicates, then the combinations contain no duplicates. -Argument <len> must be a positive integer no greater than the length of <seq>, -and <seq> must be a sequence. +Argument <len> must be a nonnegative integer no greater than the length of +<seq>, and <seq> must be a sequence. The combinations in the returned list are sequences of the same kind as <seq>. @@ -7962,6 +7962,32 @@ permutations is of zero length. The combinations are lexicographically ordered. +.SS Function rcomb + +.TP +Syntax: + + (rcomb <seq> <len>) + +.TP +Description: + +The comb function returns a lazy list which consists of all +length <len> repeating combinations formed by taking items taken from +<seq>. "Repeating combinations" means that the combinations can use +an element of <seq> more than once. + +Argument <len> must be a nonnegative integer, and <seq> must be a sequence. + +The combinations in the returned list are sequences of the same kind as <seq>. + +If <len> is zero, then a list containing one combination is returned, and that +permutations is of zero length. This is true even if <seq> is empty. + +If <seq> is empty, and <len> is nonzero, then an empty list is returned. + +The combinations are lexicographically ordered. + .SH CHARACTERS AND STRINGS .SS Function mkstring |