add fun=>, op=>

3 files changed, 45 insertions, 1 deletions

diff --git a/mew.scm b/mew.scm
index 4caebd1..524c10c 100644
--- a/mew.scm
+++ b/mew.scm
@@ -27,7 +27,7 @@
      -> fun-> fun->> set->
      =? <>?
      ~?
-     => =>* and=> set=>
+     => =>* and=> fun=> op=> set=>
 
      generic-make-accumulator)
 
@@ -975,6 +975,28 @@
              (and result
                   (apply and=> result (cdr fs)))))))
 
+  (define-syntax fun=>-inner
+    (syntax-rules ()
+      ((_ (acc ...))
+       (compose acc ...))
+      ((_ (acc ...) ,arg args ...)
+       (fun=>-inner (arg acc ...) args ...))
+      ((_ (acc ...) (arg ...) args ...)
+       (fun=>-inner ((op arg ...) acc ...) args ...))
+      ((_ (acc ...) arg args ...)
+       (fun=>-inner (arg acc ...) args ...))
+      ))
+
+  (define-syntax fun=>
+    (syntax-rules ()
+      ((fun=> . args)
+       (fun=>-inner () . args))))
+
+  (define-syntax op=>
+    (syntax-rules (_)
+      ((op=> init . args)
+       ((fun=> . args) init))))
+
   (define-syntax proj
     (er-macro-transformer
       (lambda (expr rename compare)
diff --git a/mew.svnwiki b/mew.svnwiki
index c705e29..e6b437c 100644
--- a/mew.svnwiki
+++ b/mew.svnwiki
@@ -227,6 +227,16 @@ Shortcut for {{(set <loc> (=> <loc> <fun>...))}}.
 Apply the first function in {{<fun>}} to {{<obj>}}, then the second to
 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.
+
+<procedure>(fun=> <form>...)</procedure>
+
+Like {{per}}, but all {{<form>}} which are lists implicitly use {{op}}.
+If {{<form>}} is not a list, or an unquoted {{,}} list, it is used as is.
+
 <procedure>(juxt <fun>...)</procedure>
 
 Returns a function that applies each {{<fun>}} to its arguments and
diff --git a/tests/test.mew b/tests/test.mew
index 92eb35c..e674481 100644
--- a/tests/test.mew
+++ b/tests/test.mew
@@ -531,6 +531,18 @@
   (test 42 (and=> 40 inc inc))
   (test #f (and=> 40 odd? inc)))
 
+(test-group "op=>"
+  (test 42 (op=> 40 (+ _ 1) inc))
+  (test #f (op=> 40 inc even?))
+  (test 43 (op=> '(6 7) (apply * _) inc))
+  (test 42 (op=> 42)))
+
+(test-group "fun=>"
+  (test 42 ((fun=> (+ _ 1) inc) 40))
+  (test #f ((fun=> inc even?) 40))
+  (test 43 ((fun=> * inc) 6 7))
+  (test 42 ((fun=>) 42)))
+
 (test-group "void"
   (test #t (void? (void)))
   (test #t (void? (void 1 2 3))))