diff options
author | Leah Neukirchen <leah@vuxu.org> | 2022-11-17 23:37:25 +0100 |
---|---|---|
committer | Leah Neukirchen <leah@vuxu.org> | 2022-11-17 23:37:25 +0100 |
commit | beb92ad9009f6b6a338430ba137e33201cca2230 (patch) | |
tree | f1ec893dff80a389cb6594f0cec2b35d8930a41b | |
parent | 78ebb6e306d843bb45c0baad563be37828d32fae (diff) | |
download | mew-beb92ad9009f6b6a338430ba137e33201cca2230.tar.gz mew-beb92ad9009f6b6a338430ba137e33201cca2230.tar.xz mew-beb92ad9009f6b6a338430ba137e33201cca2230.zip |
add imp
-rw-r--r-- | mew.scm | 9 | ||||
-rw-r--r-- | mew.svnwiki | 6 | ||||
-rw-r--r-- | tests/test.mew | 13 |
3 files changed, 27 insertions, 1 deletions
diff --git a/mew.scm b/mew.scm index 261c389..7250d1e 100644 --- a/mew.scm +++ b/mew.scm @@ -8,7 +8,7 @@ fail fin final for fun* gconcatenate gen generic-for-each genumerate get gfix giterate gmatch gpick group-by-accumulator gslice-when gsplit gwindow - inc inject into + imp inc inject into juxt keys len loc @@ -840,6 +840,13 @@ (list knil) lists)) + (define-syntax imp + (syntax-rules () + ((_ a b) + (or (not a) b)) + ((_ a b c ...) + (or (not a) (imp b c ...))))) + (let ((old-repl-prompt (repl-prompt))) (repl-prompt (lambda () diff --git a/mew.svnwiki b/mew.svnwiki index aaebac3..3968b98 100644 --- a/mew.svnwiki +++ b/mew.svnwiki @@ -254,6 +254,12 @@ Returns true if {{<va>}} is an unspecified value, else false. Like {{fold}}/{{fold-right}}, but collects all accumulator values. +<syntax>(imp <antedecent>... <consequent>)<syntax> + +Material implication: evaluate {{<antedecent>...}} until one is false, +then shortcut and return true. If all {{<antedecent>...}} are true, +evaluate {{<consequent>}}. + == I/O helpers diff --git a/tests/test.mew b/tests/test.mew index 295d293..b08bfd6 100644 --- a/tests/test.mew +++ b/tests/test.mew @@ -525,4 +525,17 @@ (test '(5 -1 6 0) (scan-right - 0 '(4 5 6))) (test '(42) (scan-right * 42 '()))) +(test-group "imp" + (test #t (imp #t #t)) + (test #f (imp #t #f)) + (test #t (imp #f #t)) + (test #t (imp #f #f)) + + (test #t (imp #f (error "not reached"))) + (test #t (imp #t #t #f (error "not reached"))) + (test 42 (imp #t #t #t 42)) + (test 42 (imp 39 40 41 42)) + (test #t (imp 39 #f 41 42))) + + (test-exit) |