sum and prod take keyfun argument.

* eval.c (eval_init): Adjust registrations of sum and prod to
be binary functions with an optional argument.

* lib.c (nary_op_keyfun, sumv, prodv): New static functions.
(sum, prod): Implement optional keyfun argument via sumv and
prodv helpers.

* lib.h (sum, prod): Declarations updated.

* txr.1: Documentation updated.

4 files changed, 66 insertions, 21 deletions

diff --git a/eval.c b/eval.c
index 2f803a70..c6022329 100644
--- a/eval.c
+++ b/eval.c
@@ -6400,8 +6400,8 @@ void eval_init(void)
   reg_fun(plus_s = intern(lit("+"), user_package), func_n0v(plusv));
   reg_fun(intern(lit("-"), user_package), func_n1v(minusv));
   reg_fun(intern(lit("*"), user_package), func_n0v(mulv));
-  reg_fun(intern(lit("sum"), user_package), func_n1(sum));
-  reg_fun(intern(lit("prod"), user_package), func_n1(prod));
+  reg_fun(intern(lit("sum"), user_package), func_n2o(sum, 1));
+  reg_fun(intern(lit("prod"), user_package), func_n2o(prod, 1));
   reg_fun(intern(lit("abs"), user_package), func_n1(abso));
   reg_fun(intern(lit("trunc"), user_package), func_n2o(trunc, 1));
   reg_fun(intern(lit("mod"), user_package), func_n2(mod));
diff --git a/lib.c b/lib.c
index 7e4edd9c..5da925e9 100644
--- a/lib.c
+++ b/lib.c
@@ -3212,6 +3212,31 @@ val nary_op(val self, val (*bfun)(val, val),
   return acc;
 }
 
+static val nary_op_keyfun(val self, val (*bfun)(val, val),
+                          val (*ufun)(val self, val),
+                          struct args *args, val emptyval,
+                          val keyfun)
+{
+  val acc, next;
+  cnum index = 0;
+
+  if (!args_more(args, index))
+    return emptyval;
+
+  acc = funcall1(keyfun, args_get(args, &index));
+
+  if (!args_more(args, index))
+    return ufun(self, acc);
+
+  do {
+    next = funcall1(keyfun, args_get(args, &index));
+    acc = bfun(acc, next);
+  } while (args_more(args, index));
+
+  return acc;
+}
+
+
 val nary_simple_op(val self, val (*bfun)(val, val),
                    struct args *args, val firstval)
 {
@@ -3408,16 +3433,26 @@ val numneqv(struct args *args)
   return t;
 }
 
-val sum(val seq)
+static val sumv(struct args *nlist, val keyfun)
+{
+  return nary_op_keyfun(lit("+"), plus, unary_arith, nlist, zero, keyfun);
+}
+
+val sum(val seq, val keyfun)
 {
   args_decl_list(args, ARGS_MIN, tolist(seq));
-  return plusv(args);
+  return if3(missingp(keyfun), plusv(args), sumv(args, keyfun));
+}
+
+static val prodv(struct args *nlist, val keyfun)
+{
+  return nary_op_keyfun(lit("*"), mul, unary_num, nlist, one, keyfun);
 }
 
-val prod(val seq)
+val prod(val seq, val keyfun)
 {
   args_decl_list(args, ARGS_MIN, tolist(seq));
-  return mulv(args);
+  return if3(missingp(keyfun), mulv(args), prodv(args, keyfun));
 }
 
 val max2(val a, val b)
diff --git a/lib.h b/lib.h
index 64a08e3d..aab0083d 100644
--- a/lib.h
+++ b/lib.h
@@ -712,8 +712,8 @@ val gev(val first, struct args *rest);
 val lev(val first, struct args *rest);
 val numeqv(val first, struct args *rest);
 val numneqv(struct args *list);
-val sum(val seq);
-val prod(val seq);
+val sum(val seq, val keyfun);
+val prod(val seq, val keyfun);
 val max2(val a, val b);
 val min2(val a, val b);
 val maxv(val first, struct args *rest);
diff --git a/txr.1 b/txr.1
index cdcf22d6..e3f7ba46 100644
--- a/txr.1
+++ b/txr.1
@@ -35172,34 +35172,46 @@ value of the last division is returned.
 
 .coNP Functions @ sum and @ prod
 .synb
-.mets (sum << num-sequence )
-.mets (prod << num-sequence )
+.mets (sum < sequence <> [ keyfun ])
+.mets (prod < sequence <> [ keyfun ])
 .syne
 .desc
 The
 .code sum
 and
 .code prod
-functions operate on a single argument
-.metn num-sequence ,
-which is a sequence of numbers.
+functions operate on an effective sequence of numbers derived from
+.metn sequence .
+
+If the
+.meta keyfun
+argument is omitted, then the effective sequence is the
+.meta sequence
+argument itself. Otherwise, the effective sequence is understood to be
+a projection mapping of the elements of
+.meta sequence
+through
+.meta keyfun
+as would be calculated by the
+.cblk
+.meti (mapcar < keyfun << sequence )
+.cble
+expression.
 
 The
 .code sum
 function returns the left-associative sum of the elements of
-.meta num-sequence
-calculated as if using the
+the effective sequence calculated as if using the
 .code +
 function.  Similarly, the
 .code prod
 function calculates the left-associative product of the elements of
-.metn num-sequence ,
-as if using the
+the sequence as if using the
 .code *
 function.
 
 If
-.meta num-sequence
+.meta sequence
 is empty then
 .code sum
 returns
@@ -35209,9 +35221,7 @@ and
 returns
 .codn 1 .
 
-If
-.meta num-sequence
-contains one number, then both functions
+If the effective sequence contains one number, then both functions
 return that number.
 
 .coNP Functions @ wrap and @ wrap*