From effd37e7ed64dd0300b37af1a102febea84c9504 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sun, 21 Apr 2019 03:36:43 -0700
Subject: New function: window-mapdo.

* lib.c (enum wmap_op): New enum type.
(window_map_list): Use enum wmap_op for last argument instead
of Boolean flag. If the argument is WMAP_MAPDO, do not
accumulate.
(window_map_vec, window_map, window_mapped): Adjust to new
enum argument.
(window_mapdo): New function.

* lib.h (window_mapdo): Declared.

* eval.c (eval_init): window-mapdo intrinsic registered.

* txr.1: Documented.
---
 eval.c |  1 +
 lib.c  | 52 ++++++++++++++++++++++++++++++++++++++++------------
 lib.h  |  1 +
 txr.1  | 10 +++++++++-
 4 files changed, 51 insertions(+), 13 deletions(-)

diff --git a/eval.c b/eval.c
index df6b23e1..a91d7bc8 100644
--- a/eval.c
+++ b/eval.c
@@ -6404,6 +6404,7 @@ void eval_init(void)
   reg_fun(intern(lit("maprend"), user_package), func_n1v(maprendv));
   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(intern(lit("window-mapdo"), user_package), func_n4(window_mapdo));
   {
     val apply_f = func_n1v(applyv);
     reg_fun(apply_s, apply_f);
diff --git a/lib.c b/lib.c
index ec8735e1..342e4837 100644
--- a/lib.c
+++ b/lib.c
@@ -8092,7 +8092,12 @@ static cnum calc_win_size(cnum ra)
   return ws;
 }
 
-static val window_map_list(val range, val boundary, val fun, val list, val app)
+enum wmap_op {
+  WMAP_MAP, WMAP_MAPPEND, WMAP_MAPDO
+};
+
+static val window_map_list(val range, val boundary, val fun, val list,
+                           enum wmap_op op)
 {
   val self = lit("window-map");
   cnum i, j, ra = c_fixnum(range, self), ws = calc_win_size(ra);
@@ -8126,12 +8131,14 @@ static val window_map_list(val range, val boundary, val fun, val list, val app)
 
   for (;;) {
     args_decl (args_cp, ws);
-
     args_copy(args_cp, args);
+    val item = generic_funcall(fun, args_cp);
 
-    ptail = if3(app,
-                list_collect_append,
-                list_collect)(ptail, generic_funcall(fun, args_cp));
+    switch (op) {
+    case WMAP_MAP: ptail = list_collect(ptail, item); break;
+    case WMAP_MAPPEND: ptail = list_collect_append(ptail, item); break;
+    case WMAP_MAPDO: (void) item; break;
+    }
 
     if (nilp(list = cdr(list)))
       break;
@@ -8150,10 +8157,11 @@ static val window_map_list(val range, val boundary, val fun, val list, val app)
   return out;
 }
 
-static val window_map_vec(val range, val boundary, val fun, val seq, val app)
+static val window_map_vec(val range, val boundary, val fun, val seq,
+                          enum wmap_op op)
 {
   val list = tolist(seq);
-  val out = window_map_list(range, boundary, fun, list, app);
+  val out = window_map_list(range, boundary, fun, list, op);
   return make_like(out, seq);
 }
 
@@ -8164,12 +8172,12 @@ val window_map(val range, val boundary, val fun, val seq)
     return nil;
   case CONS:
   case LCONS:
-    return window_map_list(range, boundary, fun, seq, nil);
+    return window_map_list(range, boundary, fun, seq, WMAP_MAP);
   case VEC:
   case LIT:
   case STR:
   case LSTR:
-    return window_map_vec(range, boundary, fun, seq, nil);
+    return window_map_vec(range, boundary, fun, seq, WMAP_MAP);
   default:
     type_mismatch(lit("window-map: ~s is not a sequence"), seq, nao);
   }
@@ -8182,14 +8190,34 @@ val window_mappend(val range, val boundary, val fun, val seq)
     return nil;
   case CONS:
   case LCONS:
-    return window_map_list(range, boundary, fun, seq, t);
+    return window_map_list(range, boundary, fun, seq, WMAP_MAPPEND);
   case VEC:
   case LIT:
   case STR:
   case LSTR:
-    return window_map_vec(range, boundary, fun, seq, t);
+    return window_map_vec(range, boundary, fun, seq, WMAP_MAPPEND);
   default:
-    type_mismatch(lit("window-map: ~s is not a sequence"), seq, nao);
+    type_mismatch(lit("window-mappend: ~s is not a sequence"), seq, nao);
+  }
+}
+
+val window_mapdo(val range, val boundary, val fun, val seq)
+{
+  switch (type(seq)) {
+  case NIL:
+    return nil;
+  case CONS:
+  case LCONS:
+    (void) window_map_list(range, boundary, fun, seq, WMAP_MAPDO);
+    return nil;
+  case VEC:
+  case LIT:
+  case STR:
+  case LSTR:
+    (void) window_map_vec(range, boundary, fun, seq, WMAP_MAPDO);
+    return nil;
+  default:
+    type_mismatch(lit("window-mapdo: ~s is not a sequence"), seq, nao);
   }
 }
 
diff --git a/lib.h b/lib.h
index 624c24fa..79137610 100644
--- a/lib.h
+++ b/lib.h
@@ -1055,6 +1055,7 @@ 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 window_mapdo(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 a4a98179..640c1e16 100644
--- a/txr.1
+++ b/txr.1
@@ -29488,10 +29488,11 @@ on a list of the arguments. The following equivalences hold:
   (zip '(a b c) '(c d e)) ->  ((a c) (b d) (c e))
 .brev
 
-.coNP Functions @ window-map and @ window-mappend
+.coNP Functions @, window-map @ window-mappend and @ window-mapdo
 .synb
 .mets (window-map < range < boundary < function << sequence )
 .mets (window-mappend < range < boundary < function << sequence )
+.mets (window-mapdo < range < boundary < function << sequence )
 .syne
 .desc
 The
@@ -29528,6 +29529,13 @@ they perform a
 .IR "sliding window mapping" ,
 whose description follows.
 
+The function
+.code window-mappend
+avoids accumulating a sequence, and instead returns
+.codn nil ;
+it is analogous to
+.codn mapdo .
+
 The argument to the
 .meta range
 parameter must be a positive integer, not exceeding 512.
-- 
cgit v1.2.3