diff options
| -rw-r--r-- | args.h | 5 | ||||
| -rw-r--r-- | eval.c | 2 | ||||
| -rw-r--r-- | lib.c | 113 | ||||
| -rw-r--r-- | lib.h | 2 | ||||
| -rw-r--r-- | txr.1 | 154 |
5 files changed, 276 insertions, 0 deletions
@@ -53,6 +53,11 @@ INLINE struct args *args_init(struct args *args, cnum argc) return args_init_list(args, argc, nil); } +INLINE void args_set_fill(struct args *args, cnum fill) +{ + args->fill = fill; +} + #define args_decl_list(NAME, N, L) \ mem_t *NAME ## _mem = \ coerce(mem_t *, \ @@ -4446,6 +4446,8 @@ void eval_init(void) reg_fun(intern(lit("mappend"), user_package), func_n1v(mappendv)); reg_fun(intern(lit("mappend*"), user_package), func_n1v(lazy_mappendv)); reg_fun(intern(lit("mapdo"), user_package), func_n1v(mapdov)); + reg_fun(intern(lit("window-map"), user_package), func_n4(window_map)); + reg_fun(intern(lit("window-mappend"), user_package), func_n4(window_mappend)); reg_fun(apply_s, func_n1v(applyv)); reg_fun(iapply_s, func_n1v(iapply)); reg_fun(call_s, call_f); @@ -102,6 +102,7 @@ val system_error_s; val gensym_counter_s; val nothrow_k, args_k, colon_k, auto_k, fun_k; +val wrap_k, reflect_k; val null_string; val nil_string; @@ -6495,6 +6496,116 @@ val mapdo(val fun, val list) return nil; } +static cnum calc_win_size(cnum ra) +{ + cnum ws = 2 * ra + 1; + if (ra < 1) + uw_throwf(error_s, lit("window-map: range must be nonnegative"), nao); + if (ws > 1025) + uw_throwf(error_s, lit("window-map: window size exceeds 1025"), nao); + return ws; +} + +static val window_map_list(val range, val boundary, val fun, val list, val app) +{ + cnum i, j, ra = c_num(range), ws = calc_win_size(ra); + val iter; + args_decl (args, ws); + list_collect_decl (out, ptail); + + args_set_fill(args, ws); + + if (boundary == wrap_k) { + val lcopy = take(range, list); + while (lt(length(lcopy), range)) + lcopy = append2(lcopy, lcopy); + boundary = append2(sub(lcopy, num_fast(-ra), t), sub(lcopy, zero, range)); + } else if (boundary == reflect_k) { + val lcopy = take(range, list); + while (lt(length(lcopy), range)) + lcopy = append2(lcopy, lcopy); + boundary = nappend2(nreverse(sub(lcopy, zero, range)), + nreverse(sub(lcopy, num_fast(-ra), t))); + } + + for (i = 0; i < ra; i++) + args->arg[i] = ref(boundary, num_fast(i)); + + for (iter = list; iter && i < ws; iter = cdr(iter), i++) + args->arg[i] = car(iter); + + for (j = ra; i < ws; i++) + args->arg[i] = ref(boundary, num_fast(j++)); + + for (;;) { + args_decl (args_cp, ws); + + args_copy(args_cp, args); + + ptail = if3(app, + list_collect_append, + list_collect)(ptail, generic_funcall(fun, args_cp)); + + if (nilp(list = cdr(list))) + break; + + for (i = 0; i < ws - 1; i++) + args->arg[i] = args->arg[i + 1]; + + if (iter) { + args->arg[i] = car(iter); + iter = cdr(iter); + } else { + args->arg[i] = ref(boundary, num_fast(j++)); + } + } + + return out; +} + +static val window_map_vec(val range, val boundary, val fun, val seq, val app) +{ + val list = tolist(seq); + val out = window_map_list(range, boundary, fun, list, app); + return make_like(out, seq); +} + +val window_map(val range, val boundary, val fun, val seq) +{ + switch (type(seq)) { + case NIL: + return nil; + case CONS: + case LCONS: + return window_map_list(range, boundary, fun, seq, nil); + case VEC: + case LIT: + case STR: + case LSTR: + return window_map_vec(range, boundary, fun, seq, nil); + default: + type_mismatch(lit("window-map: ~s is not a sequence"), seq, nao); + } +} + +val window_mappend(val range, val boundary, val fun, val seq) +{ + switch (type(seq)) { + case NIL: + return nil; + case CONS: + case LCONS: + return window_map_list(range, boundary, fun, seq, t); + case VEC: + case LIT: + case STR: + case LSTR: + return window_map_vec(range, boundary, fun, seq, t); + default: + type_mismatch(lit("window-map: ~s is not a sequence"), seq, nao); + } +} + static val lazy_interpose_func(val env, val lcons) { cons_bind (sep, list, env); @@ -7938,6 +8049,8 @@ static void obj_init(void) colon_k = intern(lit(""), keyword_package); auto_k = intern(lit("auto"), keyword_package); fun_k = intern(lit("fun"), keyword_package); + wrap_k = intern(lit("wrap"), keyword_package); + reflect_k = intern(lit("reflect"), keyword_package); equal_f = func_n2(equal); eq_f = func_n2(eq); @@ -875,6 +875,8 @@ val mapcar(val fun, val list); val mapcon(val fun, val list); val mappend(val fun, val list); val mapdo(val fun, val list); +val window_map(val range, val boundary, val fun, val seq); +val window_mappend(val range, val boundary, val fun, val seq); val interpose(val sep, val seq); val merge(val list1, val list2, val lessfun, val keyfun); val sort(val seq, val lessfun, val keyfun); @@ -21615,6 +21615,160 @@ on a list of the arguments. The following equivalences hold: (zip '(a b c) '(c d e)) -> ((a c) (b d) (c e)) .cble +.coNP Functions @ window-map and @ window-mappend +.synb +.mets (window-map < range < boundary < function << sequence ) +.mets (window-mappend < range < boundary < function << sequence ) +.syne +.desc +The +.code window-map +and +.code window-mappend +functions process the elements of +.meta sequence +by passing arguments derived from each successive element to +.metn function . +Both functions return, if possible, a sequence of the same kind as +.codn sequence , +otherwise a list. + +Under +.codn window-map , +.meta function +is expected to return a sequence. The sequences returned +by the calls to +.meta function +are appended together to form the sequence that, possibly after a conversion to +the same type as +.meta sequence +becomes the output sequence. Under +.codn window-mappend , +the values returned by the calls to +.meta function +are appended together. + +These functions respectively resemble +.code mapcar +and +.code mappend +respectively. However, they operate only on a single sequence. +Moreover, they perform a +.IR "window mapping" , +explained as follows. + +The argument to the +.meta range +parameter must be a positive integer, not exceeding 512. +This parameter specified the amount of ahead/behind context on either +side of each element which is processed. It indirectly determines +the window size for the mapping. The window size is twice +.metn range , +plus one. For instance if range is , then the window size is 5: +the element being processed lies at the center of the window, flanked +by two elements on either side, making five. + +The +.meta function +argument must specify a function which accepts a number of arguments +corresponding to the window size. For instance if +.meta range +is 2, +making the window size 5, +then +.meta function +must accept 5 arguments. These arguments constitute the sliding +window being processed. Each time +.meta function +is called, the middle argument is the element being processed, +and the arguments surrounding it are its window. + +When an element is processed from somewhere in the interior of +a sequence, where it is flanked on either side by at least +.meta range +elements, then the window is populated by those flanking elements +taken from +.metn sequence . + +The +.meta boundary +parameter specifies the window contents which are used for the +processing of elements which are closer than +.meta range +to either end of the sequence. The argument may be a sequence containing +at least twice +.meta range +number of elements (one less than the window size): if it has additional +elements, they are not used. If it is a list, it may be shorter than twice +.metn range . +The argument +may also be one of the two keyword symbols +.code :wrap +or +.codn :reflect , +described below. + +If +.meta boundary +is a sequence, it may be regarded as divided into two pieces of +.meta range +length. If it is a list of insufficient length, then missing elements +are supplied as +.code nil +to make two +.metn range 's +worth of elements. These two pieces then flank +.code sequence +on either end. The left half of +.meta boundary +is effectively prepended to the sequence, and the right half +effectively appended. +When the sliding window extends beyond the boundary of +.meta sequence +near its start or end, the window is populated from these +flanking elements obtained from +.metn boundary . + +If +.meta boundary +is the keyword +.codn :wrap , +then the sequence is effectively flanked by copies of itself on both +ends, repeated enough times to satisfy the window. For instance if +the sequence is +.code (1 2 3) +and the window size is 9 due to the value of +.meta range +being 7, then the behavior of +.code :wrap +is as if a +.meta boundary +were specified consisting of +.codn (3 1 2 3 1 2 3 1) . +The left flank is +.code (3 1 2 3) +and the right flank is +.code (1 2 3 4) +formed by repetitions of +.code (1 2 3) +surrounding it on either side, extending out to infinity, and chopped to +.metn range . + +If +.meta boundary +is the keyword +.codn :reflect , +then the sequence is effectively flanked by reversed copies of itself +on both ends, repeated enough times to satisfy the window. +For instance if the sequence is +.code (1 2 3) +and the window size is 9, then the behavior of +.code :wrap +is as if a +.meta boundary +were specified consisting of +.codn (1 3 2 1 3 2 1 3) . + .coNP Function @ interpose .synb .mets (interpose < sep << sequence ) |