From 9d02e5eeaf953c60ba0fe98a3b4309defa3fc868 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sat, 5 Aug 2017 21:11:30 -0700
Subject: Add sum and prod convenience functions.

* eval.c (eval_init): prod and sum intrinsics registered.

* lib.c (sum, prod): New functions.

* lib.h (sum, prod): Declared.

* txr.1: Documented.
---
 eval.c |  2 ++
 lib.c  | 12 ++++++++++++
 lib.h  |  2 ++
 txr.1  | 44 ++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 60 insertions(+)

diff --git a/eval.c b/eval.c
index 63968f35..00e65163 100644
--- a/eval.c
+++ b/eval.c
@@ -5829,6 +5829,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("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 b8a165f5..bf7ce8ce 100644
--- a/lib.c
+++ b/lib.c
@@ -3277,6 +3277,18 @@ val numneqv(struct args *args)
   return t;
 }
 
+val sum(val seq)
+{
+  args_decl_list(args, ARGS_MIN, tolist(seq));
+  return plusv(args);
+}
+
+val prod(val seq)
+{
+  args_decl_list(args, ARGS_MIN, tolist(seq));
+  return mulv(args);
+}
+
 val max2(val a, val b)
 {
   return if3(less(a, b), b, a);
diff --git a/lib.h b/lib.h
index c1a898c2..6df5a914 100644
--- a/lib.h
+++ b/lib.h
@@ -691,6 +691,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 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 3c2937e0..09791147 100644
--- a/txr.1
+++ b/txr.1
@@ -33472,6 +33472,50 @@ follows, then that value is divided by that subsequent divisor.
 This process repeats until all divisors are exhausted, and the
 value of the last division is returned.
 
+.coNP Functions @ sum and @ prod
+.synb
+.mets (sum << num-sequence )
+.mets (prod << num-sequence )
+.syne
+.desc
+The
+.code sum
+and
+.code prod
+functions operate on a single argument
+.metn num-sequence ,
+which is a sequence of numbers.
+
+The
+.code sum
+function returns the left-associative sum of the elements of
+.meta num-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
+.code *
+function.
+
+If
+.meta num-sequence
+is empty then
+.code sum
+returns
+.code 0
+and
+.code prod
+returns
+.codn 1 .
+
+If
+.meta num-sequence
+contains one number, then both functions
+return that number.
+
 .coNP Functions @ wrap and @ wrap*
 .synb
 .mets (wrap < start < end << number )
-- 
cgit v1.2.3