From 9142bb19726b62492e2f4c6ecb8bc7a5fe9b712f Mon Sep 17 00:00:00 2001
From: Leah Neukirchen <leah@vuxu.org>
Date: Wed, 7 Dec 2022 01:49:46 +0100
Subject: op=> only transform lists which contain _

---
 mew.scm        | 15 ++++++++++++---
 mew.svnwiki    |  3 ++-
 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=>"
-- 
cgit 1.4.1