diff options
| -rw-r--r-- | stdlib/arith-each.tl | 22 | ||||
| -rw-r--r-- | tests/016/arith.tl | 20 | ||||
| -rw-r--r-- | tests/016/log.tl | 42 | ||||
| -rw-r--r-- | txr.1 | 37 |
4 files changed, 111 insertions, 10 deletions
diff --git a/stdlib/arith-each.tl b/stdlib/arith-each.tl index 80f783c7..ba8c8c8a 100644 --- a/stdlib/arith-each.tl +++ b/stdlib/arith-each.tl @@ -34,15 +34,19 @@ (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)))))))) + (accum (gensym)) + (op (car op-iv)) + (iv (cdr op-iv))) + (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) + (,*(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))))))))) (defmacro sum-each (:form f vars . body) (sys:vars-check f vars) diff --git a/tests/016/arith.tl b/tests/016/arith.tl index ad919e6b..24521921 100644 --- a/tests/016/arith.tl +++ b/tests/016/arith.tl @@ -255,10 +255,18 @@ 1.5 2.25 2.625 2.8125 2.90625)) (mtest + (sum-each ()) + 0 + (sum-each ((x nil))) + 0 (sum-each ((x '(1 2 3)) (y '(4 5 6))) (* x y)) 32 + (mul-each ()) + 1 + (mul-each ((x nil))) + 1 (mul-each ((x '(1 2 3)) (y '(4 5 6))) (+ x y)) @@ -281,6 +289,12 @@ :error) (mtest + (sum-each-prod ()) + 0 + (sum-each-prod ((x nil))) + 0 + (sum-each-prod ((x '(4))) x) + 4 (sum-each-prod ((x '(1 2 3)) (y '(4 3 2))) (* x y)) @@ -295,6 +309,12 @@ :error) (mvtest + (mul-each-prod ()) + 1 + (mul-each-prod ((x nil))) + 1 + (mul-each-prod ((x '(4))) x) + 4 (mul-each-prod ((x '(1 2 3)) (y '(4 3 2))) (+ x y)) diff --git a/tests/016/log.tl b/tests/016/log.tl new file mode 100644 index 00000000..3dcd9056 --- /dev/null +++ b/tests/016/log.tl @@ -0,0 +1,42 @@ +(load "../common.tl") + +(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 ()) :error + (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 ()) :error + (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 ()) :error + (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) @@ -17747,6 +17747,24 @@ 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. +When +.code sum-each* +and +.code sum-each +are specified with variables whose values specify zero iterations, +or with no variables at all, the form terminates with a value of +.codn 0 . +In this situation, +.code mul-each +and +.code mul-each* +terminate with +.codn 1 . +Note that this behavior differs from +.codn each , +and its closely-related operators, which loop infinitely when no variables are +specified. + .coNP Macros @, each-prod @ collect-each-prod and @ append-each-prod .synb .mets (each-prod >> ({( sym << init-form )}*) << body-form *) @@ -17782,6 +17800,14 @@ operator family, the are surrounded by an anonymous block. If these forms execute a return from this block, then these macros terminate with the specified return value. +When no iterations are performed, including in the case when an empty +list of variables is specified, all these macro forms terminate and return +.codn nil . +Note that this behavior differs from +.codn each , +and its closely-related operators, which loop infinitely when no variables are +specified. + With one caveat noted below, these macros can be understood as providing syntactic sugar according to the pattern established by the following equivalences: @@ -17799,7 +17825,6 @@ equivalences: body) body) #:gx #:gy)) - (append-each-prod (block nil ((x xinit) (let ((#:gx xinit) (#:gy yinit)) (y yinit)) <--> (maprend (lambda (x y) @@ -17914,6 +17939,16 @@ The 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. +When no iterations are specified, including in the case when an empty +list of variables is specified, the summing macros terminate, yielding +.codn 0 , +and the multiplicative macros terminate with +.codn 1 . +Note that this behavior differs from +.codn each , +and its closely-related operators, which loop infinitely when no variables are +specified. + .TP* Examples: .verb |