From a4fe85e6df2e308241984294a3d35353d7cc083a Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 12 Jan 2022 07:04:03 -0800
Subject: 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.
---
 tests/016/arith.tl | 41 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 41 insertions(+)

(limited to 'tests/016/arith.tl')

diff --git a/tests/016/arith.tl b/tests/016/arith.tl
index 24521921..d740835b 100644
--- a/tests/016/arith.tl
+++ b/tests/016/arith.tl
@@ -331,3 +331,44 @@
                   (y (cdr x)))
     (* x y))
   :error)
+
+(mtest
+  (each-true ()) t
+  (each-true ((a ()))) t
+  (each-true ((a ())) nil) t
+  (each-true ((a '(1 2 3))) a) 3
+  (each-true ((a '(nil 2 3))) a) nil
+  (each-true ((a '(1 2 3)) (b '(4 5 6))) (< a b)) t
+  (each-true ((a '(1 2 3)) (b '(4 0 6))) (< a b)) nil)
+
+(mtest
+  (some-true ()) nil
+  (some-true ((a ()))) nil
+  (some-true ((a ())) nil) nil
+  (some-true ((a '(1 2 3))) a) 1
+  (some-true ((a '(nil 2 3))) a) 2
+  (some-true ((a '(nil nil nil))) a) nil
+  (some-true ((a '(1 2 3)) (b '(4 5 6))) (< a b)) t
+  (some-true ((a '(1 2 3)) (b '(4 0 6))) (< a b)) t
+  (some-true ((a '(1 2 3)) (b '(0 1 2))) (< a b)) nil)
+
+(mtest
+  (each-false ()) t
+  (each-false ((a ()))) t
+  (each-false ((a ())) t) t
+  (each-false ((a '(1 2 3))) a) nil
+  (each-false ((a '(nil))) a) t
+  (each-false ((a '(nil nil))) a) t
+  (each-false ((a '(1 2 3)) (b '(4 5 6))) (> a b)) t
+  (each-false ((a '(1 2 3)) (b '(4 0 6))) (> a b)) nil)
+
+(mtest
+  (some-false ()) nil
+  (some-false ((a ()))) nil
+  (some-false ((a ())) nil) nil
+  (some-false ((a '(1 2 3))) a) nil
+  (some-false ((a '(nil 2 3))) a) t
+  (some-false ((a '(nil nil nil))) a) t
+  (some-false ((a '(1 2 3)) (b '(4 5 6))) (> a b)) t
+  (some-false ((a '(1 2 3)) (b '(4 0 6))) (> a b)) t
+  (some-false ((a '(1 2 3)) (b '(0 1 2))) (> a b)) nil)
-- 
cgit v1.2.3