84 lines
3.1 KiB
Scheme
84 lines
3.1 KiB
Scheme
(define-module (radix combinators)
|
|
#:use-module (ice-9 curried-definitions)
|
|
#:use-module (ice-9 match)
|
|
#:export (all-of
|
|
any-of
|
|
conjoin
|
|
disjoin
|
|
inclusive-disjoin
|
|
flip
|
|
juxt
|
|
on
|
|
partial
|
|
swap))
|
|
|
|
(define* ((all-of pred) lst)
|
|
"Returns a procedure that takes a list LST and returns #t if every other
|
|
element of LST satisfies PRED."
|
|
(null? (filter (negate pred) lst)))
|
|
|
|
(define* ((any-of pred) lst)
|
|
"Returns a procedure that takes a list LST and returns #t if any element of
|
|
LST satisfies PRED."
|
|
(let loop ((lst lst))
|
|
(match
|
|
('() #f)
|
|
((head . tail)
|
|
(cond ((pred head) #t)
|
|
(else (loop tail)))))))
|
|
|
|
(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."
|
|
(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) . 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."
|
|
(match (filter (partial (flip apply) args) predicates)
|
|
((_) #t)
|
|
(else #f)))
|
|
|
|
(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."
|
|
(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)
|
|
"Returns a procedure that receives MORE-ARGS applies PROC to the list
|
|
obtained by appending ARGS to MORE-ARGS."
|
|
(apply proc (append args more-args)))
|
|
|
|
(define* ((flip proc) . args)
|
|
"Returns a procedure that applies PROC to the reverse of ARGS."
|
|
(apply proc (reverse args)))
|
|
|
|
(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."
|
|
(apply proc arg2 arg1 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)))
|
|
|
|
(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)))
|