New functions window-map and window-mappend.

* args.h (args_set_fill): New inline function.

* eval.c (eval_init): Register window-map and window-mappend
intrinics.

* lib.c (wrap_k, reflect_k): New keyword variables.
(calc_win_size): New static function.
(window_map_list, window_map_vec): New static functions.
(window_map, window_mappend): New functions.
(obj_init): Initialize wrap_k and reflect_k.

* lib.h (window_map, window_mappend): Declared.

* txr.1: Documented window-map and window-mappend

5 files changed, 276 insertions, 0 deletions

diff --git a/args.h b/args.h
index 23869d30..8634de9e 100644
--- a/args.h
+++ b/args.h
@@ -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 *,                                                     \
diff --git a/eval.c b/eval.c
index b1bb0d17..e0880962 100644
--- a/eval.c
+++ b/eval.c
@@ -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);
diff --git a/lib.c b/lib.c
index 751d8a3b..39686e3d 100644
--- a/lib.c
+++ b/lib.c
@@ -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);
diff --git a/lib.h b/lib.h
index 7b33c784..80412c29 100644
--- a/lib.h
+++ b/lib.h
@@ -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);
diff --git a/txr.1 b/txr.1
index 8200178a..5f59f01d 100644
--- a/txr.1
+++ b/txr.1
@@ -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 )