summary refs log tree commit diff
diff options
context:
space:
mode:
authorLeah Neukirchen <leah@vuxu.org>2022-11-17 23:37:25 +0100
committerLeah Neukirchen <leah@vuxu.org>2022-11-17 23:37:25 +0100
commitbeb92ad9009f6b6a338430ba137e33201cca2230 (patch)
treef1ec893dff80a389cb6594f0cec2b35d8930a41b
parent78ebb6e306d843bb45c0baad563be37828d32fae (diff)
downloadmew-beb92ad9009f6b6a338430ba137e33201cca2230.tar.gz
mew-beb92ad9009f6b6a338430ba137e33201cca2230.tar.xz
mew-beb92ad9009f6b6a338430ba137e33201cca2230.zip
add imp
-rw-r--r--mew.scm9
-rw-r--r--mew.svnwiki6
-rw-r--r--tests/test.mew13
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)