New variants of each operator for sum and product.

* lisplib.c (arith_each_instantiate, arith_each_set_entries): New
functions.
(each_prod_set_entries): Add sum-each-prod, sum-each-prod*,
mul-each-prod and mul-each-prod* as autoload triggers for
each-prod.tl, where those macros are now defined.
(lisplib_init): Register autoloading of arith-each.tl via the
two new functions.

* stdlib/arith-each.tl: New file.

* stdlib/each-prod.tl (sys:expand-each-prod*): Handle sum-each-prod* and
mul-each-prod* in the same way, by mapping to their parallel binding
counterparts.
(sys:expand-arith-each-prod): New function.
(sym-each-prod, mul-each-prod, sum-each-prod*, mul-each-prod*): New
macros.

* tests/016/arith.tl: New tests.

* txr.1: Documented.

* stdlib/doc-syms.tl: Updated.

1 files changed, 30 insertions, 1 deletions

diff --git a/stdlib/each-prod.tl b/stdlib/each-prod.tl
index d1a9c15a..1393b80a 100644
--- a/stdlib/each-prod.tl
+++ b/stdlib/each-prod.tl
@@ -50,12 +50,29 @@
   (let* ((each-prod-op (caseq (car form)
                          (each-prod* 'each-prod)
                          (collect-each-prod* 'collect-each-prod)
-                         (append-each-prod* 'append-each-prod)))
+                         (append-each-prod* 'append-each-prod)
+                         (sum-each-prod* 'sum-each-prod)
+                         (mul-each-prod* 'mul-each-prod)))
          (syms [mapcar car vars])
          (inits [mapcar cadr vars]))
     ^(let* ,vars
        (,each-prod-op ,(zip syms syms) ,*body))))
 
+(defun sys:expand-arith-each-prod (form vars body)
+  (sys:vars-check form vars)
+  (let ((syms [mapcar car vars])
+        (inits [mapcar cadr vars]))
+    (sys:bindable-check form syms)
+    (let ((op-iv (caseq (car form)
+                   (sum-each-prod '(+ . 0))
+                   (mul-each-prod '(* . 1)))))
+      (with-gensyms (acc)
+        ^(let ((,acc ,(cdr op-iv)))
+           (maprodo (lambda (,*syms)
+                      (set ,acc (,(car op-iv) ,acc (progn ,*body))))
+                    ,*inits)
+           ,acc)))))
+
 (defmacro each-prod (:form f vars . body)
   (sys:expand-each-prod f vars body))
 
@@ -65,6 +82,12 @@
 (defmacro append-each-prod (:form f vars . body)
   (sys:expand-each-prod f vars body))
 
+(defmacro sum-each-prod (:form f vars . body)
+  (sys:expand-arith-each-prod f vars body))
+
+(defmacro mul-each-prod (:form f vars . body)
+  (sys:expand-arith-each-prod f vars body))
+
 (defmacro each-prod* (:form f vars . body)
   (sys:expand-each-prod* f vars body))
 
@@ -73,3 +96,9 @@
 
 (defmacro append-each-prod* (:form f vars . body)
   (sys:expand-each-prod* f vars body))
+
+(defmacro sum-each-prod* (:form f vars . body)
+  (sys:expand-each-prod* f vars body))
+
+(defmacro mul-each-prod* (:form f vars . body)
+  (sys:expand-each-prod* f vars body))