diff --git a/radix/combinators.scm b/radix/combinators.scm index de967d4..7079def 100644 --- a/radix/combinators.scm +++ b/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)) - (match - ('() #f) - ((head . tail) - (cond ((pred head) #t) - (else (loop tail)))))))) + (let loop ((lst lst)) + (match + ('() #f) + ((head . tail) + (cond ((pred head) #t) + (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 - (match-let loop (((head-pred . tail-preds) predicates)) - (cond ((null? tail-preds) (apply head-pred args)) - ((apply head-pred args) (loop tail-preds)) - (else #f)))))) + (if (null? predicates) #t + (match-let loop (((head-pred . tail-preds) predicates)) + (cond ((null? tail-preds) (apply head-pred args)) + ((apply head-pred args) (loop tail-preds)) + (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 - (match-let loop (((head-pred . tail-preds) predicates)) - (cond ((null? tail-preds) (apply head-pred args)) - ((not (apply head-pred args)) (loop tail-preds)) - (else #f)))))) + (if (null? predicates) #f + (match-let loop (((head-pred . tail-preds) predicates)) + (cond ((null? tail-preds) (apply head-pred args)) + ((not (apply head-pred args)) (loop tail-preds)) + (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) - (cons proc more-procs)))) + (map (partial (flip apply) args) + (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)))