product/arithmetic each: missing block nil.

* stdlib/arith-each.tl (sys:vars-check): New function, copy
and pasted from each-prod.tl.
(sys:arith-each): New macro.
(sum-each, sum-each*, mul-each, mul-each*): Reworked using
sys:arith-each macro.  This macro uses logic borrowed from
a stripped-down expand-each in the compiler.

* stdlib/each-prod.tl (sys:expand-each-prod,
sys:expand-arith-each-prod*): Add the block nil around the
mapping call, taking care that the initialization forms
are evaluated outside of the block, and their values bound to
gensyms that then form the function arguments.

* txr.1: Document the missing requirements for all the
affected macros that there must be an anonymous block around
the body, which, if used, determines the return value.

3 files changed, 91 insertions, 63 deletions

diff --git a/stdlib/arith-each.tl b/stdlib/arith-each.tl
index b0be94ab..edae748f 100644
--- a/stdlib/arith-each.tl
+++ b/stdlib/arith-each.tl
@@ -25,30 +25,45 @@
 ;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 ;; POSSIBILITY OF SUCH DAMAGE.
 
-(defmacro sum-each (vars . body)
-  (with-gensyms (accum)
-    ^(let ((,accum 0))
-       (each ,vars
-         (inc ,accum (progn ,*body)))
-       ,accum)))
+(defun sys:vars-check (form vars)
+  (unless (listp vars)
+    (compile-error form "~s is expected to be variable binding syntax" vars))
+  (whenlet ((bad (find-if [notf consp] vars)))
+    (compile-error form "~s isn't a var-initform pair" bad)))
 
-(defmacro sum-each* (vars . body)
-  (with-gensyms (accum)
-    ^(let ((,accum 0))
-       (each* ,vars
-         (inc ,accum (progn ,*body)))
-       ,accum)))
+(defmacro sys:arith-each (:form f op-iv vars . body)
+  (let* ((gens (mapcar (ret (gensym)) vars))
+         (syms [mapcar car vars])
+         (accum (gensym)))
+    ^(let* (,*(mapcar (ret ^(,@1 (iter-begin ,@2))) gens syms)
+            (,accum ,(cdr op-iv)))
+       (block nil
+         (sys:for-op ()
+           ((and ,*(mapcar (op list 'iter-more) gens)) ,accum)
+           (,*(mapcar (ret ^(sys:setq ,@1 (iter-step ,@1))) gens))
+           ,*(mapcar (ret ^(sys:setq ,@1 (iter-item ,@2))) syms gens)
+           (set ,accum (,(car op-iv) ,accum (progn ,*body))))))))
 
-(defmacro mul-each (vars . body)
-  (with-gensyms (accum)
-    ^(let ((,accum 1))
-       (each ,vars
-         (set ,accum (* ,accum (progn ,*body))))
-       ,accum)))
+(defmacro sum-each (:form f vars . body)
+  (sys:vars-check f vars)
+  ^(let ,vars
+     (block nil
+       (sys:arith-each (+ . 0) ,vars ,*body))))
 
-(defmacro mul-each* (vars . body)
-  (with-gensyms (accum)
-    ^(let ((,accum 1))
-       (each* ,vars
-         (set ,accum (* ,accum (progn ,*body))))
-       ,accum)))
+(defmacro sum-each* (:form f vars . body)
+  (sys:vars-check f vars)
+  ^(let* ,vars
+     (block nil
+       (sys:arith-each (+ . 0) ,vars ,*body))))
+
+(defmacro mul-each (:form f vars . body)
+  (sys:vars-check f vars)
+  ^(let ,vars
+     (block nil
+       (sys:arith-each (* . 1) ,vars ,*body))))
+
+(defmacro mul-each* (:form f vars . body)
+  (sys:vars-check f vars)
+  ^(let* ,vars
+     (block nil
+       (sys:arith-each (* . 1) ,vars ,*body))))
diff --git a/stdlib/each-prod.tl b/stdlib/each-prod.tl
index 1393b80a..d48263f6 100644
--- a/stdlib/each-prod.tl
+++ b/stdlib/each-prod.tl
@@ -37,13 +37,16 @@
 (defun sys:expand-each-prod (form vars body)
   (sys:vars-check form vars)
   (let ((syms [mapcar car vars])
-        (inits [mapcar cadr vars]))
+        (inits [mapcar cadr vars])
+        (gens [mapcar (ret (gensym)) vars]))
     (sys:bindable-check form syms)
     (let ((fun (caseq (car form)
                  (each-prod 'maprodo)
                  (collect-each-prod 'maprod)
                  (append-each-prod 'maprend))))
-      ^(,fun (lambda (,*syms) ,*body) ,*inits))))
+      ^(let ,(zip gens inits)
+         (block nil
+           (,fun (lambda (,*syms) ,*body) ,*gens))))))
 
 (defun sys:expand-each-prod* (form vars body)
   (sys:vars-check form vars)
@@ -61,17 +64,20 @@
 (defun sys:expand-arith-each-prod (form vars body)
   (sys:vars-check form vars)
   (let ((syms [mapcar car vars])
-        (inits [mapcar cadr vars]))
+        (inits [mapcar cadr vars])
+        (gens [mapcar (ret (gensym)) 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)))))
+        ^(let ((,acc ,(cdr op-iv))
+               ,*(zip gens inits))
+           (block nil
+             (maprodo (lambda (,*syms)
+                        (set ,acc (,(car op-iv) ,acc (progn ,*body))))
+                      ,*gens)
+             ,acc))))))
 
 (defmacro each-prod (:form f vars . body)
   (sys:expand-each-prod f vars body))
diff --git a/txr.1 b/txr.1
index f2af420d..f7c9ae8c 100644
--- a/txr.1
+++ b/txr.1
@@ -17714,21 +17714,11 @@ the variable bindings, exactly the way
 alters the semantics of
 .codn each .
 
-Note: the following equivalences apply, except that the accumulator
-variable is a named by a unique, generated symbol.
-
-.verb
-  (sum-each (vars ...)  <-->  (let ((acc 0))
-    body ...)                   (each vars
-                                  (inc acc (progn body)))
-                                 acc)
-
-  (mul-each (vars ...)  <-->  (let ((acc 1))
-    body)                       (each vars
-                                  (set acc (* acc
-                                              (progn body))))
-                                acc)
-.brev
+The
+.metn body-form s
+are enclosed in an implicit anonymous block. If the forms terminate
+by returning from the anonymous block then these macros terminate
+with the specified value.
 
 .coNP Macros @, each-prod @ collect-each-prod and @ append-each-prod
 .synb
@@ -17758,24 +17748,36 @@ is analogous to that between the functions
 and
 .codn maprod .
 
-These macros can be understood as providing syntactic sugar according to the
-pattern established by the following equivalences:
+Like in the
+.code each
+operator family, the
+.metn body-form s
+are surrounded by an anonymous block. If these forms execute a return from
+this block, then these macros terminate with the specified return value.
+
+With one caveat noted below, these macros can be understood as providing
+syntactic sugar according to the pattern established by the following
+equivalences:
 
 .mono
-  (each-prod               (maprodo (lambda (x y)
-    ((x xinit)                        body)
-     (y yinit))       <-->          xinit
-    body)                           yinit)
-
-  (collect-each-prod       (maprod (lambda (x y)
-    ((x xinit)                       body)
-     (y yinit))       <-->         xinit
-    body)                          yinit)
-
-  (append-each-prod        (maprend (lambda (x y)
-    ((x xinit)                        body)
-     (y yinit))       <-->          xinit
-    body)                           yinit)
+  (each-prod               (block nil
+    ((x xinit)               (let ((#:gx xinit) (#:gy yinit))
+     (y yinit))       <-->     (maprodo (lambda (x y)
+    body)                                 body)
+                                        #:gx #:gy))
+
+  (collect-each-prod       (block nil
+    ((x xinit)               (let ((#:gx xinit) (#:gy yinit))
+     (y yinit))       <-->     (maprod (lambda (x y)
+    body)                                body)
+                                       #:gx #:gy))
+
+
+  (append-each-prod        (block nil
+    ((x xinit)               (let ((#:gx xinit) (#:gy yinit))
+     (y yinit))       <-->     (maprend (lambda (x y)
+    body)                                body)
+                                       #:gx #:gy))
 .onom
 
 However, note that each invocation of the
@@ -17880,6 +17882,11 @@ values of the variables, similarly to the
 .code each*
 operator.
 
+The
+.metn body-form s
+are surrounded by an implicit anonymous block. If these forms execute a return
+from this block, then these macros terminate with the specified return value.
+
 .TP* Examples:
 
 .verb