New Cartesian product mapping functions.

* eval.c (prod_common): New static function.
(maprodv, maprendv): New functions.
(eval_init): Registered maprod and maprend intrinsics.

* eval.h (maprodv, maprendv): Declared.

* txr.1: Documented.

3 files changed, 173 insertions, 0 deletions

diff --git a/eval.c b/eval.c
index 3bdb29f5..f8186977 100644
--- a/eval.c
+++ b/eval.c
@@ -4685,6 +4685,63 @@ static val mapdov(val fun, struct args *lists)
   }
 }
 
+static val prod_common(val fun, struct args *lists,
+                       loc (*collect_fptr)(loc ptail, val obj))
+{
+  if (!args_more(lists, 0)) {
+    return nil;
+  } else if (!args_two_more(lists, 0)) {
+    return mappendv(fun, lists);
+  } else {
+    cnum argc = args_count(lists), i;
+    args_decl(args_reset, max(argc, ARGS_MIN));
+    args_decl(args_work, max(argc, ARGS_MIN));
+    args_copy(args_reset, lists);
+    args_normalize(args_reset, argc);
+    args_copy(args_work, args_reset);
+    list_collect_decl (out, ptail);
+
+    for (i = 0; i < argc; i++)
+      args_work->arg[i] = nullify(args_work->arg[i]);
+
+    for (;;) {
+      args_decl(args_fun, max(argc, ARGS_MIN));
+      for (i = 0; i < argc; i++) {
+        val seq_i = args_work->arg[i];
+        if (!seq_i)
+          goto out;
+        args_fun->arg[i] = car(seq_i);
+      }
+
+      args_fun->fill = argc;
+      ptail = collect_fptr(ptail, generic_funcall(fun, args_fun));
+
+      for (i = argc - 1; ; i--) {
+        val cdr_i = cdr(args_work->arg[i]);
+        if (cdr_i) {
+          args_work->arg[i] = cdr_i;
+          break;
+        }
+        if (i == 0)
+          goto out;
+        args_work->arg[i] = args_reset->arg[i];
+      }
+    }
+  out:
+    return make_like(out, args_reset->arg[0]);
+  }
+}
+
+val maprodv(val fun, struct args *lists)
+{
+  return prod_common(fun, lists, list_collect);
+}
+
+val maprendv(val fun, struct args *lists)
+{
+  return prod_common(fun, lists, list_collect_append);
+}
+
 static val symbol_value(val sym)
 {
   uses_or2;
@@ -5645,6 +5702,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("maprod"), user_package), func_n1v(maprodv));
+  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));
   {
diff --git a/eval.h b/eval.h
index 4fb46426..f77a14ce 100644
--- a/eval.h
+++ b/eval.h
@@ -80,6 +80,8 @@ val bindable(val obj);
 val mapcarv(val fun, struct args *lists);
 val mapcarl(val fun, val list_of_lists);
 val lazy_mapcar(val fun, val list);
+val maprodv(val fun, struct args *lists);
+val maprendv(val fun, struct args *lists);
 val generate(val while_pred, val gen_fun);
 val retf(val ret);
 val prinl(val obj, val stream);
diff --git a/txr.1 b/txr.1
index 5cc0d178..cd47676f 100644
--- a/txr.1
+++ b/txr.1
@@ -27051,6 +27051,118 @@ and so doesn't return.
   -> (2 4)
 .cble
 
+.coNP Functions @ maprod and @ maprend
+.synb
+.mets (maprod < function << sequence *)
+.mets (maprend < function << sequence *)
+.syne
+.desc
+The
+.code maprod
+and
+.code maprend
+functions resemble
+.code mapcar
+and
+.codn mappend ,
+respectively. When given no
+.meta sequence
+arguments or exactly one
+.meta sequence
+argument, they behave exactly like those two functions.
+
+When two or more
+.meta sequence
+arguments are present,
+.code maprod
+differs from
+.code mapcar
+in the following way. Whereas
+.code mapcar
+iterates over the
+.meta sequence
+values in parallel, taking successive tuples of element
+values and passing them to
+.metn function ,
+the
+.code maprod
+function iterates over all
+.I combinations
+of elements from the sequences: the Cartesian product. The
+.code prod
+suffix stands for "product".
+
+If one or more
+.meta sequence
+arguments specify an empty sequence, then the Cartesian product is empty.
+In this situation,
+.meta function
+is not called. The result of the function is then
+.code nil
+converted to the same kind of sequence as the leftmost
+.metn sequence .
+
+The
+.code maprod
+function collects the values into a list just as
+.code mapcar
+does. Just like
+.codn mapcar ,
+it converts the resulting list into the same kind of sequence
+as the leftmost
+.meta sequence
+argument, if possible. For instance, if the resulting list is
+a list or vector of characters, and the leftmost
+.meta sequence
+is a character string, then the list or vector of characters
+is converted to a character string and returned.
+
+The
+.code maprend
+function ("map product through function and append") iterates the
+.meta sequence
+element combinations exactly like
+.codn maprod ,
+passing them as arguments to
+.metn function .
+The values returned by
+.meta function
+are then treated exactly as by the
+.code mappend
+function. The return values are expected to be sequences which
+are appended together as if by
+.codn append ,
+and the final result is converted to the same kind of sequence as the leftmost
+.meta sequence
+if possible.
+
+The combination iteration gives priority to the rightmost
+.metn sequence ,
+which means that the rightmost element of each generated tuple varies
+fastest: the tuples are traversed in "rightmost major" order.
+This is made clear in the examples.
+
+.TP* Examples
+
+.cblk
+  [maprod list '(0 1 2) '(a b) '(i ii iii)]
+  ->
+  ((0 a i) (0 a ii) (0 a iii) (0 b i) (0 b ii) (0 b iii)
+   (1 a i) (1 a ii) (1 a iii) (1 b i) (1 b ii) (1 b iii)
+   (2 a i) (2 a ii) (2 a iii) (2 b i) (2 b ii) (2 b iii))
+
+  ;; Vectors #(#\ea #\ex) #(#\ea #\ey) ... are appended
+  ;; together resulting in #(#\ea #\ex #\ea #\ey ...)
+  ;; which is converted to a string:
+
+  [maprend vec "ab" "xy"] -> "axaybxby"
+
+  ;; One of the sequences is empty, so the product is an
+  ;; empty sequence of the same kind as the leftmost
+  ;; sequence argument, thus an empty string:
+  [maprend vec "ab" ""] -> ""
+.cble
+
 .coNP Function @ mapdo
 .synb
 .mets (mapdo < function << sequence *)