Implement more feedback from Mark H. Weaver.

* module/srfi/srfi-41.scm (must, must-not, must-every): Implement
  these as direct macros, and without using negate.

1 files changed, 13 insertions, 16 deletions

diff --git a/module/srfi/srfi-41.scm b/module/srfi/srfi-41.scm
index 45b03ad3b..314127eee 100644
--- a/module/srfi/srfi-41.scm
+++ b/module/srfi/srfi-41.scm
@@ -44,23 +44,20 @@
 
 ;;; Private supporting functions and macros.
 
-(define-syntax-rule (must-not1 pred obj func msg args)
-  (when (pred obj)
-    (throw 'wrong-type-arg func msg args (list obj))))
-
-(define-syntax-rule (must-not* pred objs func msg args)
-  (let ((flunk (filter pred objs)))
+(define-syntax-rule (must pred obj func msg args ...)
+  (let ((item obj))
+    (unless (pred item)
+      (throw 'wrong-type-arg func msg (list args ...) (list item)))))
+
+(define-syntax-rule (must-not pred obj func msg args ...)
+  (let ((item obj))
+    (when (pred item)
+      (throw 'wrong-type-arg func msg (list args ...) (list item)))))
+
+(define-syntax-rule (must-every pred objs func msg args ...)
+  (let ((flunk (remove pred objs)))
     (unless (null? flunk)
-      (throw 'wrong-type-arg func msg args flunk))))
-
-(define* (must-not pred obj func msg . args)
-  (must-not1 pred obj func msg args))
-
-(define* (must pred obj func msg . args)
-  (must-not1 (negate pred) obj func msg args))
-
-(define* (must-every pred objs func msg . args)
-  (must-not* (negate pred) objs func msg args))
+      (throw 'wrong-type-arg func msg (list args ...) flunk))))
 
 ; Only the one-list version is supported since that's what we use.
 (define (pair-map proc clist)