New macros: each-true, some-true, each-false, some-false.

* lisplib.c (arith_each_set_entries): Trigger autoload on
new symbols.

* stdilb/arith-each.tl (sys:arith-each): Generalize macro to
handle short-circuiting logical operations. The op-iv
parameter, which is a cons, is spread into two op and iv
parameter.
One new argument appears, short-circ. This specifies a code
for short-circuiting behavior: t means iteration continues
while the result is true; nil means it continues while it is
nil, and + means iteration continues while the accumulator is
nonzero. A new convention is in effect: the operator has
to be specified as a list in order to request accumulating
behavior, e.g (+) or (*). Otherwise the operator specifies a
predicate that is applied to the forms, without taking into
account the prior value.
(sum-each, sum-each*, mul-each, mul-each*): Spread the op-iv
arguments. Wrap the op argument in a list to request
accumulation. In the case of mul-each and mul-each*, specify +
for the short-circ argument, which means that iteration stops
when the accumulator becomes zerop. sum-each and sum-each*
specify : for the short-circ argument which is unrecognized,
and so ther is no short-circuiting behavior.
(each-true, some-true, each-false, some-false): New macros.

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

* txr.1: Documented new macros and added note about possible
short-circuiting in mul-each and mul-each*.

* stdlib/doc-syms.tl: Updated.

1 files changed, 40 insertions, 10 deletions

diff --git a/stdlib/arith-each.tl b/stdlib/arith-each.tl
index ba8c8c8a..b2904dee 100644
--- a/stdlib/arith-each.tl
+++ b/stdlib/arith-each.tl
@@ -31,43 +31,73 @@
   (whenlet ((bad (find-if [notf consp] vars)))
     (compile-error form "~s isn't a var-initform pair" bad)))
 
-(defmacro sys:arith-each (:form f op-iv vars . body)
+(defmacro sys:arith-each (:form f fn iv short-circ vars . body)
   (let* ((gens (mapcar (ret (gensym)) vars))
          (syms [mapcar car vars])
-         (accum (gensym))
-         (op (car op-iv))
-         (iv (cdr op-iv)))
+         (accum (gensym)))
     (if (null vars)
       iv
       ^(let* (,*(mapcar (ret ^(,@1 (iter-begin ,@2))) gens syms)
                (,accum ,iv))
          (block nil
            (sys:for-op ()
-             ((and ,*(mapcar (op list 'iter-more) gens)) ,accum)
+             ((and ,*(mapcar (op list 'iter-more) gens)
+                   ,*(cond
+                       ((eq t short-circ) ^(,accum))
+                       ((null short-circ) ^((null ,accum)))
+                       ((eq '+ short-circ) ^((nzerop ,accum)))))
+              ,accum)
              (,*(mapcar (ret ^(sys:setq ,@1 (iter-step ,@1))) gens))
              ,*(mapcar (ret ^(sys:setq ,@1 (iter-item ,@2))) syms gens)
-             (set ,accum (,op ,accum (progn ,*body)))))))))
+             (set ,accum ,(cond
+                            ((consp fn) ^(,(car fn) ,accum (progn ,*body)))
+                            (fn ^(,fn (progn ,*body)))
+                            (t ^(progn ,*body))))))))))
 
 (defmacro sum-each (:form f vars . body)
   (sys:vars-check f vars)
   ^(let ,vars
      (block nil
-       (sys:arith-each (+ . 0) ,vars ,*body))))
+       (sys:arith-each (+) 0 : ,vars ,*body))))
 
 (defmacro sum-each* (:form f vars . body)
   (sys:vars-check f vars)
   ^(let* ,vars
      (block nil
-       (sys:arith-each (+ . 0) ,vars ,*body))))
+       (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))))
+       (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))))
+       (sys:arith-each (*) 1 + ,vars ,*body))))
+
+(defmacro each-true (:form f vars . body)
+  (sys:vars-check f vars)
+  ^(let* ,vars
+     (block nil
+       (sys:arith-each nil t t ,vars ,*body))))
+
+(defmacro some-true (:form f vars . body)
+  (sys:vars-check f vars)
+  ^(let* ,vars
+     (block nil
+       (sys:arith-each nil nil nil ,vars ,*body))))
+
+(defmacro each-false (:form f vars . body)
+  (sys:vars-check f vars)
+  ^(let* ,vars
+     (block nil
+       (sys:arith-each not t t ,vars ,*body))))
+
+(defmacro some-false (:form f vars . body)
+  (sys:vars-check f vars)
+  ^(let* ,vars
+     (block nil
+       (sys:arith-each not nil nil ,vars ,*body))))