summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--eval.c1
-rw-r--r--lib.c52
-rw-r--r--lib.h1
-rw-r--r--txr.110
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.