diff options
| author | Leah Neukirchen <leah@vuxu.org> | 2022-11-03 20:26:47 +0100 |
|---|---|---|
| committer | Leah Neukirchen <leah@vuxu.org> | 2022-11-03 20:26:47 +0100 |
| commit | 3e02069ff0df373cc3211d354429f6f65c71cf72 (patch) | |
| tree | 8b3c7c573eb8d67107a0730a92e412089e073feb | |
| parent | 86844e3db77c52cfff703c6e31ce7877e3fe0bba (diff) | |
| download | mew-3e02069ff0df373cc3211d354429f6f65c71cf72.tar.gz mew-3e02069ff0df373cc3211d354429f6f65c71cf72.tar.xz mew-3e02069ff0df373cc3211d354429f6f65c71cf72.zip | |
add andloc
| -rw-r--r-- | mew.el | 2 | ||||
| -rw-r--r-- | mew.scm | 11 | ||||
| -rw-r--r-- | mew.svnwiki | 6 | ||||
| -rw-r--r-- | tests/test.mew | 24 |
4 files changed, 38 insertions, 5 deletions
diff --git a/mew.el b/mew.el index db1faea..9704b9e 100644 --- a/mew.el +++ b/mew.el @@ -3,12 +3,14 @@ (put 'fin 'scheme-indent-function 0) (put 'fun 'scheme-indent-function 1) (put 'loc 'scheme-indent-function 1) +(put 'andloc 'scheme-indent-function 1) (put 'rec 'scheme-indent-function 1) (put 'rep 'scheme-indent-function 2) (put 'seq 'scheme-indent-function 0) (put 'if 'scheme-indent-function 1) (put 'match 'scheme-indent-function 1) +(put 'accumulate 'scheme-indent-function 1) (setq auto-mode-alist (cons '("\\.mew\\'" . scheme-mode) diff --git a/mew.scm b/mew.scm index 16b3479..f70fbee 100644 --- a/mew.scm +++ b/mew.scm @@ -1,6 +1,6 @@ (module mew (export - act accumulate at + act accumulate andloc at comp dec def del-at div empty? eof esc @@ -165,6 +165,15 @@ ((_ (x y . brest) . rest) (match-let ((x y)) (loc brest . rest))))) + (define-syntax andloc + (syntax-rules (_) + ((_ () . rest) + (let () . rest)) + ((_ (_ y . brest) . rest) + (let ((unused y)) (and unused (andloc brest . rest)))) + ((_ (x y . brest) . rest) + (let ((x y)) (and x (andloc brest . rest)))))) + (define-syntax fun* (syntax-rules () ((_ args body rest ...) diff --git a/mew.svnwiki b/mew.svnwiki index 54341f0..9104155 100644 --- a/mew.svnwiki +++ b/mew.svnwiki @@ -66,6 +66,12 @@ then {{pat2}} to {{val2}}, etc., then evaluates {{body}}. Assignments can refer to previously assigned values of the {{loc}}. +<syntax>(andloc (<var1> <val1> ... <varN> <valN>) <body>)</syntax> + +Like {{loc}} (without pattern matching), but return false when one of +the {{<valN>>}} evaluates to false. If a {{<valN>}} is {{_}}, +only performs the check without binding a value. + <syntax>(rec <name> <expression>)</syntax> <syntax>(rec (<name> <formals>) <expression>)</syntax> diff --git a/tests/test.mew b/tests/test.mew index 4fa0351..f8ee39d 100644 --- a/tests/test.mew +++ b/tests/test.mew @@ -141,12 +141,28 @@ (test-group "loc" (test 42 (loc () 42)) (test 42 (loc (a (* 6 7)) - a)) + a)) (test 42 (loc (a 6 - b (* a 7)) - b)) + b (* a 7)) + b)) (test 42 (loc ((a . b) '(42 2 3)) - a))) + a))) + +(test-group "andloc" + (test 42 (andloc () 42)) + (test 42 (andloc (a (* 6 7)) + a)) + (test 42 (andloc (a 6 + b (* a 7)) + b)) + (test #t (andloc (a 6 + c (even? a) + b (* a 7)) + c)) + (test #f (andloc (a 6 + _ (odd? a) + b (* a 7)) + a))) (test-group "fun*" (test 42 ((fun* ((a . b)) (* a b)) (cons 6 7)))) |