diff options
author | Leah Neukirchen <leah@vuxu.org> | 2022-12-07 01:49:46 +0100 |
---|---|---|
committer | Leah Neukirchen <leah@vuxu.org> | 2022-12-07 01:49:46 +0100 |
commit | 9142bb19726b62492e2f4c6ecb8bc7a5fe9b712f (patch) | |
tree | d09b55680b5056a7fc4513e22a179fba10a3486b | |
parent | bf2318462d7024050635fd4620e207d6d5a7281d (diff) | |
download | mew-9142bb19726b62492e2f4c6ecb8bc7a5fe9b712f.tar.gz mew-9142bb19726b62492e2f4c6ecb8bc7a5fe9b712f.tar.xz mew-9142bb19726b62492e2f4c6ecb8bc7a5fe9b712f.zip |
op=> only transform lists which contain _
-rw-r--r-- | mew.scm | 15 | ||||
-rw-r--r-- | mew.svnwiki | 3 | ||||
-rw-r--r-- | tests/test.mew | 1 |
3 files changed, 15 insertions, 4 deletions
diff --git a/mew.scm b/mew.scm index 0780029..917ce6c 100644 --- a/mew.scm +++ b/mew.scm @@ -1000,6 +1000,16 @@ (and result (apply and=> result (cdr fs))))))) + ;; search for _ in arguments, then call op + (define-syntax maybe-op + (syntax-rules (_) + ((_ (all ...) (_ rest ...)) + (op all ...)) + ((_ all (x rest ...)) + (maybe-op all (rest ...))) + ((_ (all ...) ()) + (all ...)))) + (define-syntax fun=>-inner (syntax-rules (unquote) ((_ (acc ...)) @@ -1007,10 +1017,9 @@ ((_ (acc ...) (unquote arg) args ...) (fun=>-inner (arg acc ...) args ...)) ((_ (acc ...) (arg ...) args ...) - (fun=>-inner ((op arg ...) acc ...) args ...)) + (fun=>-inner ((maybe-op (arg ...) (arg ...)) acc ...) args ...)) ((_ (acc ...) arg args ...) - (fun=>-inner (arg acc ...) args ...)) - )) + (fun=>-inner (arg acc ...) args ...)))) (define-syntax fun=> (syntax-rules () diff --git a/mew.svnwiki b/mew.svnwiki index 5b0d4b0..29eb4e9 100644 --- a/mew.svnwiki +++ b/mew.svnwiki @@ -230,7 +230,8 @@ the result, etc. Stop if any value is false. <procedure>(op=> <obj> <form>...)</procedure> Like {{=>}}, but all {{<form>}} which are lists implicitly use {{op}}. -If {{<form>}} is not a list, or an unquoted {{,}} list, it is used as is. +If {{<form>}} is not a list, an unquoted {{,}} list, or a list not containing +{{_}} directly, it is used as is. <procedure>(fun=> <form>...)</procedure> diff --git a/tests/test.mew b/tests/test.mew index c01bb08..589b63e 100644 --- a/tests/test.mew +++ b/tests/test.mew @@ -551,6 +551,7 @@ (test 42 (op=> 40 ,(op inc _) inc)) (test #f (op=> 40 inc even?)) (test 43 (op=> '(6 7) (apply * _) inc)) + (test 43 (op=> '(6 7) unlist (compose *) inc)) (test 42 (op=> 42))) (test-group "fun=>" |