* eval.c (me_ap): New static function.

(eval_init): Use new list_f instead of func_n0v(identity).
Register multi as intrinsic.  Register me_ap as ap macro.

* lib.c (list_f): New global variable.
(multi): New function.
(multi_sort): Use list_f in place of func_n0v(identity).
(obj_init): gc-protect and initialize list_f.

* lib.h (list_f, multi): Declared.

* txr.1: Documented multi and ap.

5 files changed, 123 insertions, 11 deletions

diff --git a/ChangeLog b/ChangeLog
index a736d4bb..b52a0678 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+2014-06-19  Kaz Kylheku  <kaz@kylheku.com>
+
+	* eval.c (me_ap): New static function.
+	(eval_init): Use new list_f instead of func_n0v(identity).
+	Register multi as intrinsic.  Register me_ap as ap macro.
+
+	* lib.c (list_f): New global variable.
+	(multi): New function.
+	(multi_sort): Use list_f in place of func_n0v(identity).
+	(obj_init): gc-protect and initialize list_f.
+
+	* lib.h (list_f, multi): Declared.
+
+	* txr.1: Documented multi and ap.
+
 2014-06-18  Kaz Kylheku  <kaz@kylheku.com>
 
 	* eval.c (eval_init): Register member and member_if as intrinsics.
diff --git a/eval.c b/eval.c
index 45c1c08a..fe6337b6 100644
--- a/eval.c
+++ b/eval.c
@@ -2367,6 +2367,16 @@ static val me_op(val form, val menv)
   }
 }
 
+static val me_ap(val form, val menv)
+{
+  /* We do not use an op to generate the outer lambda, because
+     it wouldn't be hygienic; this hidden op would capture @@n
+     references from the body of the ap form. */
+  val args = gensym(lit("args-"));
+  return list(lambda_s, cons(args, nil),
+              list(apply_s, cons(op_s, rest(form)), args, nao), nao);
+}
+
 static val expand_catch_clause(val form, val menv)
 {
   val sym = first(form);
@@ -3201,6 +3211,7 @@ void eval_init(void)
   reg_mac(intern(lit("delay"), user_package), me_delay);
   reg_mac(op_s, me_op);
   reg_mac(do_s, me_op);
+  reg_mac(intern(lit("ap"), user_package), me_ap);
   reg_mac(qquote_s, me_qquote);
   reg_mac(sys_qquote_s, me_qquote);
   reg_mac(intern(lit("pprof"), user_package), me_pprof);
@@ -3223,7 +3234,7 @@ void eval_init(void)
   reg_fun(intern(lit("replace-list"), user_package), func_n4o(replace_list, 2));
   reg_fun(append_s, func_n0v(appendv));
   reg_fun(intern(lit("append*"), user_package), func_n0v(lazy_appendv));
-  reg_fun(list_s, func_n0v(identity));
+  reg_fun(list_s, list_f);
   reg_fun(intern(lit("list*"), user_package), func_n0v(list_star_intrinsic));
   reg_fun(intern(lit("identity"), user_package), identity_f);
   reg_fun(intern(lit("typeof"), user_package), func_n1(typeof));
@@ -3290,6 +3301,7 @@ void eval_init(void)
   reg_fun(intern(lit("some"), user_package), func_n3o(some_satisfy, 1));
   reg_fun(intern(lit("all"), user_package), func_n3o(all_satisfy, 1));
   reg_fun(intern(lit("none"), user_package), func_n3o(none_satisfy, 1));
+  reg_fun(intern(lit("multi"), user_package), func_n1v(multi));
   reg_fun(intern(lit("eq"), user_package), eq_f);
   reg_fun(intern(lit("eql"), user_package), eql_f);
   reg_fun(intern(lit("equal"), user_package), equal_f);
diff --git a/lib.c b/lib.c
index 2507d8f6..b3b808ed 100644
--- a/lib.c
+++ b/lib.c
@@ -97,6 +97,7 @@ val nil_string;
 val null_list;
 
 val identity_f, equal_f, eql_f, eq_f, gt_f, lt_f, car_f, cdr_f, null_f;
+val list_f;
 
 val prog_string;
 
@@ -1209,6 +1210,13 @@ val none_satisfy(val list, val pred, val key)
   return t;
 }
 
+val multi(val func, val lists)
+{
+  val transposed = mapcarv(list_f, lists);
+  val processed = funcall1(func, transposed);
+  return mapcarv(list_f, processed);
+}
+
 val flatten(val list)
 {
   if (list == nil)
@@ -5004,7 +5012,7 @@ static val multi_sort_less(val funcs_cons, val llist, val rlist)
 
 val multi_sort(val lists, val funcs, val key_funcs)
 {
-  val tuples = mapcarv(func_n0v(identity), nullify(lists));
+  val tuples = mapcarv(list_f, nullify(lists));
 
   key_funcs = default_bool_arg(key_funcs);
 
@@ -5014,7 +5022,7 @@ val multi_sort(val lists, val funcs, val key_funcs)
   tuples = sort_list(tuples, func_f2(cons(funcs, key_funcs),
                                      multi_sort_less), identity_f);
 
-  return mapcarv(func_n0v(identity), tuples);
+  return mapcarv(list_f, tuples);
 }
 
 val find(val item, val list, val testfun, val keyfun)
@@ -5568,7 +5576,7 @@ static void obj_init(void)
   protect(&packages, &system_package_var, &keyword_package_var,
           &user_package_var, &null_string, &nil_string,
           &null_list, &equal_f, &eq_f, &eql_f, &gt_f, &lt_f,
-          &car_f, &cdr_f, &null_f,
+          &car_f, &cdr_f, &null_f, &list_f,
           &identity_f, &prog_string, &env_list,
           (val *) 0);
 
@@ -5700,6 +5708,7 @@ static void obj_init(void)
   car_f = func_n1(car);
   cdr_f = func_n1(cdr);
   null_f = func_n1(null);
+  list_f = func_n0v(identity);
   prog_string = string(progname);
 }
 
diff --git a/lib.h b/lib.h
index bd50a3da..3e792bd7 100644
--- a/lib.h
+++ b/lib.h
@@ -378,7 +378,7 @@ extern val null_string;
 extern val null_list; /* (nil) */
 
 extern val identity_f, equal_f, eql_f, eq_f, gt_f, lt_f, car_f, cdr_f, null_f;
-
+extern val list_f;
 
 extern const wchar_t *progname;
 extern val prog_string;
@@ -465,6 +465,7 @@ val count_if(val pred, val list, val key);
 val some_satisfy(val list, val pred, val key);
 val all_satisfy(val list, val pred, val key);
 val none_satisfy(val list, val pred, val key);
+val multi(val func, val lists);
 val eql(val left, val right);
 val equal(val left, val right);
 mem_t *chk_malloc(size_t size);
diff --git a/txr.1 b/txr.1
index d13bac52..8389f9ab 100644
--- a/txr.1
+++ b/txr.1
@@ -8296,6 +8296,54 @@ Examples:
   ;; none of the integers are even
   [none '(1 3 4 7) evenp] -> t
 
+.SS Function multi
+
+.TP
+Syntax:
+
+  (multi <function> <list>*)
+
+.TP
+Description:
+
+The multi function distributes an arbitrary list processing function <multi>
+over multiple lists given by the <list> arguments.
+
+The <list> arguments are first transposed into a single list of tuples. Each
+successive element of this transposed list consists of a combination of the
+successive items from the lists. The length of the transposed list is that
+of the shortest <list> argument.
+
+The transposed list is then passed to <function> as an argument.
+
+The <function> is expected to produce a list of tuples, which are transposed
+again to produce a list of lists which is then returned.
+
+Conceptually, the input lists are columns and <function> is invoked on
+a list of the rows formed from these columns. The output of <function>
+is a transformed list of rows which is reconstituted into a list of columns.
+
+.TP
+Example:
+
+  ;; Take three lists in parallel, and remove from all of them
+  ;; them the element at all positions where the third list
+  ;; has an element of 20.
+
+  (multi (op remove-if (op eql 20) @1 third)
+         '(1 2 3)
+         '(a b c)
+         '(10 20 30))
+
+  -> ((1 3) (a c) (10 30))
+
+  ;; The (2 b 20) "row" is gone from the three "columns".
+
+  ;; Note that the (op remove if (op eql 20) @1 third)
+  ;; expression can be simplified using the ap operator:
+  ;;
+  ;; (op remove-if (ap eql @3 20))
+
 .SH ASSOCIATION LISTS
 
 Association lists are ordinary lists formed according to a special convention.
@@ -11765,13 +11813,13 @@ value is then used as the data item in the intersection hash.
 .TP
 Syntax:
 
-  (op {<form>}+)
-  (do {<form>}+)
+  (op <form>+)
+  (do <form>+)
 
 .TP
 Description:
 
-The op and do macro operators are similar. 
+The op and do macro operators are similar.
 
 Like the lambda operator, the op operator creates an anonymous function.
 The difference is that the arguments of the function are implicit, or
@@ -11863,9 +11911,9 @@ Examples:
 .TP
 Nested op:
 
-The op and do operators can be nested. This raises the question: if a
-metanumber like @1 or @rest occurs in an op that is nested within an op,
-what is the meaning?
+The op and do operators can be nested, in any combination. This raises the
+question: if a metanumber like @1 or @rest occurs in an op that is nested
+within an op, what is the meaning?
 
 A metanumber always belongs with the inner-most op or do operator. So for
 instance  (op (op @1)) means that an (op @1) expression is nested
@@ -11882,6 +11930,33 @@ is the first argument of the inner function. Of course, if there
 are three levels of nesting, then three metas are needed to insert
 a parameter from the outermost op, into the innermost op.
 
+.SS Macro ap
+
+.TP
+Syntax:
+
+  (ap <form>+)
+
+.TP
+Description:
+
+The ap macro is based on the op macro and has identical argument
+conventions.
+
+The ap macro analyzes its argumetns and produces a function, in exactly the
+same same way as the op macro.   It then returns a different one-argument
+function which accepts a list, and calls that function, applying the
+list as arguments.
+
+In other words, the following equivalence holds:
+
+  (ap form ...) <--> (lambda (args) (apply (op form ...)))
+
+except that the symbol args is to be understood as a generated symbol (gensym).
+
+The ap macro nests properly with op and do, in any combination, in regard
+to the @@n notation.
+
 .SS Function chain
 
 .TP