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.

1 files changed, 14 insertions, 8 deletions

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))