diff --git a/modules/radix/combinators.scm b/modules/radix/combinators.scm index d341728..21e6084 100644 --- a/modules/radix/combinators.scm +++ b/modules/radix/combinators.scm @@ -1,6 +1,4 @@ (define-module (radix combinators) - #:use-module (srfi srfi-26) - #:use-module (ice-9 curried-definitions) #:use-module (ice-9 match) #:export (all-of any-of @@ -12,44 +10,72 @@ partial swap)) -(define ((all-of pred) lst) - (null? (filter (negate pred) lst))) +(define (all-of pred) + "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)))) -(define ((any-of pred) lst) - (cond ((null? lst) #f) - ((pred (car lst)) #t) - (else (any? pred (cdr lst))))) +(define (any-of pred) + "Returns a procedure that takes a list LST and returns #t if any element of +LST satisfies pred." + (match-lambda + (() #f) + ((head . tail) + (cond ((pred head) #t) + (else (any? pred tail)))))) -#| (conjoin (list (conjoin '()) predicates)) = (conjoin predicates) |# -(define ((conjoin . predicates) . 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))))) +(define (conjoin . predicates) + "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)))))) -#| (disjoin (list (disjoin '()) predicates)) = (disjoin predicates) |# -(define ((disjoin . predicates) . args) - (if (null? predicates) #f - (= 1 (length (filter (cut apply <> args) - predicates))))) +(define (disjoin . predicates) + "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 satisfy exactly one predicate in PREDICATES, and +#f otherwise." + (lambda args + (match (filter (partial (flip apply) args) predicates) + ((_) #t) + (else #f)))) -(define ((inclusive-disjoin . predicates) . 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))))) +(define (inclusive-disjoin . predicates) + "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)))))) -(define ((partial proc . args) . more-args) - (apply proc (append args more-args))) +(define (partial proc . 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)))) -(define ((flip proc) . args) - (apply proc (reverse args))) +(define (flip proc) + "Returns a procedure that applies PROC to the reverse of ARGS." + (lambda args (apply proc (reverse args)))) -(define ((swap proc) arg1 arg2 . args) - (apply proc arg2 arg1 args)) +(define ((swap proc) arg1 arg2 . more-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))) -(define ((juxt proc . more-procs) arg . more-args) - (map (lambda (proc) (apply proc arg more-args)) +(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)." + (map (partial (flip apply) args) (cons proc more-procs)))