From 53fb3e6b09dbe62d66c516870855ba448f56c4b0 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sat, 19 Jul 2014 10:24:10 -0700
Subject: * eval.c (mapdov): New function. (eval_init): Register mapdo
 intrinsic.

* lib.c (mapdo): New function.

* lib.h (mapdo): Declared.

* txr.1: Documented mapdo.  Documented zero-argument case
for mapcar, mapcar*, mappend and mappend*.
---
 ChangeLog | 12 ++++++++++++
 eval.c    | 25 +++++++++++++++++++++++++
 lib.c     | 10 ++++++++++
 lib.h     |  1 +
 txr.1     | 38 +++++++++++++++++++++++++++++++++-----
 5 files changed, 81 insertions(+), 5 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 006d02d2..f84751b4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2014-07-19  Kaz Kylheku  <kaz@kylheku.com>
+
+	* eval.c (mapdov): New function.
+	(eval_init): Register mapdo intrinsic.
+
+	* lib.c (mapdo): New function.
+
+	* lib.h (mapdo): Declared.
+
+	* txr.1: Documented mapdo.  Documented zero-argument case
+	for mapcar, mapcar*, mappend and mappend*.
+
 2014-07-19  Kaz Kylheku  <kaz@kylheku.com>
 
 	* stream.c (put_strings, put_lines): New functions.
diff --git a/eval.c b/eval.c
index c071843d..6e596272 100644
--- a/eval.c
+++ b/eval.c
@@ -2958,6 +2958,30 @@ static val lazy_mappendv(val fun, val list_of_lists)
   return lazy_appendv(lazy_mapcarv(fun, list_of_lists));
 }
 
+static val mapdov(val fun, val list_of_lists)
+{
+  if (!cdr(list_of_lists)) {
+    return mapdo(fun, car(list_of_lists));
+  } else {
+    val lofl = mapcar_listout(func_n1(nullify), list_of_lists);
+
+    for (;;) {
+      val iter;
+      list_collect_decl (args, atail);
+
+      for (iter = lofl; iter; iter = cdr(iter)) {
+        val list = car(iter);
+        if (!list)
+          return nil;
+        atail = list_collect(atail, car(list));
+        deref(car_l(iter)) = cdr(list);
+      }
+
+      apply(fun, args, nil);
+    }
+  }
+}
+
 static val symbol_value(val sym)
 {
   return cdr(lookup_var(nil, sym));
@@ -3506,6 +3530,7 @@ void eval_init(void)
   reg_fun(intern(lit("mapcar*"), user_package), func_n1v(lazy_mapcarv));
   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(apply_s, func_n1v(apply_intrinsic));
   reg_fun(iapply_s, func_n1v(iapply));
   reg_fun(call_s, func_n1v(call));
diff --git a/lib.c b/lib.c
index 9289250a..0f705211 100644
--- a/lib.c
+++ b/lib.c
@@ -4979,6 +4979,16 @@ val mappend(val fun, val list)
   return make_like(out, list_orig);
 }
 
+val mapdo(val fun, val list)
+{
+  list = nullify(list);
+
+  for (; list; list = cdr(list))
+    funcall1(fun, car(list));
+
+  return nil;
+}
+
 static val lazy_interpose_func(val env, val lcons)
 {
   cons_bind (sep, list, env);
diff --git a/lib.h b/lib.h
index 27b5c544..30931b4b 100644
--- a/lib.h
+++ b/lib.h
@@ -743,6 +743,7 @@ val mapcar_listout(val fun, val list);
 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 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 abce3d55..47ac3388 100644
--- a/txr.1
+++ b/txr.1
@@ -8058,15 +8058,18 @@ preserved.
 .TP
 Syntax:
 
-  (mapcar <function> <list> <list>*)
-  (mappend <function> <list> <list>*)
-  (mapcar* <function> <list> <list>*)
-  (mappend* <function> <list> <list>*)
+  (mapcar <function> <list>*)
+  (mappend <function> <list>*)
+  (mapcar* <function> <list>*)
+  (mappend* <function> <list>*)
 
 .TP
 Description:
 
-When given three arguments, the mapcar function applies <function> to
+When given only one argument, the mapcar function returns nil.
+The <function> is never called.
+
+When given two arguments, the mapcar function applies <function> to
 the elements of <list> and returns a list of the resulting values.
 Essentially, the list is filtered through the function.
 
@@ -8124,6 +8127,31 @@ Examples:
   (mappend (lambda (item) (if (evenp x) (list x))) '(1 2 3 4 5))
   -> (2 4)
 
+.SS Function mapdo
+
+.TP
+Syntax:
+
+  (mapdo <function> <sequence>*)
+
+.TP
+Description:
+
+The mapdo function is similar to mapcar, but always returns nil.  It is useful
+when <function> performs some kind of side effect, hence the "do" in the name,
+which is a mnemonic for the execution of imperative actions.
+
+When only the <function> argument is given, the function is never called,
+and nil is returned.
+
+If a single <sequence> argument is given, then mapdo iterates over
+<sequence>, invoking <function> on each element.
+
+If two or more <sequence> arguments are given, then mapdo iterates over
+the sequences in parallel, extracting parallel tuples of items. These
+tuples are passed as arguments to <function>, which must accept as many
+arguments as there are sequences.
+
 .SS Functions transpose and zip
 
 .TP
-- 
cgit v1.2.3