combinators: Add on

radix/combinators.scm

@@ -1,4 +1,5 @@
 (define-module (radix combinators)
+  #:use-module (ice-9 curried-definitions)
   #:use-module (ice-9 match)
   #:export (all-of
             any-of
@@ -7,37 +8,36 @@
             inclusive-disjoin
             flip
             juxt
+            on
             partial
             swap))
 
-(define (all-of pred)
+(define* ((all-of pred) lst)
   "Returns a procedure that takes a list LST and returns #t if every other 
 element of LST satisfies PRED."
-  (lambda (lst) (null? (filter (negate pred) lst))))
+  (null? (filter (negate pred) lst)))
 
-(define (any-of pred)
+(define* ((any-of pred) lst)
   "Returns a procedure that takes a list LST and returns #t if any element of
 LST satisfies PRED."
-  (lambda (lst)
+  (let loop ((lst lst))
-    (let loop ((lst lst))
+    (match
-      (match
+      ('() #f)
-        ('() #f)
+      ((head . tail)
-        ((head . tail)
+       (cond ((pred head) #t)
-         (cond ((pred head) #t)
+             (else (loop tail)))))))
-               (else (loop tail))))))))
 
-(define (conjoin . predicates)
+(define* ((conjoin . predicates) args)
   "Returns a procedure that is the conjuction of every predicate in PREDICATES.
 The returned procedure takes an arbitrary number of arguments, and returns #t
 if these arguments satisfy every other predicate in PREDICATES."
-  (lambda args
+  (if (null? predicates) #t
-    (if (null? predicates) #t
+    (match-let loop (((head-pred . tail-preds) predicates))
-      (match-let loop (((head-pred . tail-preds) predicates))
+      (cond ((null? tail-preds) (apply head-pred args))
-        (cond ((null? tail-preds) (apply head-pred args))
+            ((apply head-pred args) (loop tail-preds))
-              ((apply head-pred args) (loop tail-preds))
+            (else #f)))))
-              (else #f))))))
 
-(define (disjoin . predicates)
+(define* ((disjoin . predicates) args)
   "Returns a procedure that is the disjunction of every predicate in PREDICATES.
 The returned procedure takes an arbitrary number of arguments, and returns #t if
  these arguments satisfy exactly one predicate in PREDICATES, and #f otherwise."
@@ -46,38 +46,39 @@ The returned procedure takes an arbitrary number of arguments, and returns #t if
       ((_)  #t)
       (else #f))))
 
-(define (inclusive-disjoin . predicates)
+(define* ((inclusive-disjoin . predicates) args)
   "Returns a procedure that is the inclusive disjunction of every predicate in
 PREDICATES. The returned procedure takes an arbitrary number of arguments, and
 returns #t if these arguments satifsy at least one predicate in PREDICATES, and
 #f otherwise."
-  (lambda args
+  (if (null? predicates) #f
-    (if (null? predicates) #f
+    (match-let loop (((head-pred . tail-preds) predicates))
-      (match-let loop (((head-pred . tail-preds) predicates))
+      (cond ((null? tail-preds) (apply head-pred args))
-        (cond ((null? tail-preds) (apply head-pred args))
+            ((not (apply head-pred args)) (loop tail-preds))
-              ((not (apply head-pred args)) (loop tail-preds))
+            (else #f)))))
-              (else #f))))))
 
-(define (partial proc . args)
+(define* ((partial proc . args) more-args)
   "Returns a procedure that receives MORE-ARGS applies PROC to the list
 obtained by appending ARGS to MORE-ARGS."
-  (lambda more-args (apply proc (append args more-args))))
+  (apply proc (append args more-args)))
 
-(define (flip proc)
+(define* ((flip proc) args)
   "Returns a procedure that applies PROC to the reverse of ARGS."
-  (lambda args (apply proc (reverse args))))
+  (apply proc (reverse args)))
 
-(define (swap proc)
+(define* ((swap proc) arg1 arg2 . args)
   "Returns a procedure that takes ARG1, ARG2 and optionally more args, and
 applies PROC to the list obtained by cons*ing ARG2 ARG1 to ARG2 to the list
 of aditional arguments."
-  (lambda (arg1 arg2 . args)
+  (apply proc arg2 arg1 args))
-    (apply proc arg2 arg1 args)))
 
-(define (juxt proc . more-procs)
+(define* ((juxt proc . more-procs) args)
   "Returns a procedure that is the juxtaposition of it's argument procedures.
 The returned procedure takes a variable number of args, and returns a list
 containing the result of applying each procedure to the args (left-to-right)."
-  (lambda args
+  (map (partial (flip apply) args)
-    (map (partial (flip apply) args)
+     (cons proc more-procs)))
-       (cons proc more-procs))))
+
+(define* ((on proc1 proc2) . args)
+  "Returns a procedure that applies PROC1 to the to the map of PROC2 to ARGS."
+  (apply proc1 (map proc2 args)))