diff --git a/files/lf/.lfrc.swp b/files/lf/.lfrc.swp deleted file mode 100644 index c59a563..0000000 Binary files a/files/lf/.lfrc.swp and /dev/null differ diff --git a/modules/radix/combinators.scm b/modules/radix/combinators.scm index d903e48..4332d17 100644 --- a/modules/radix/combinators.scm +++ b/modules/radix/combinators.scm @@ -1,41 +1,39 @@ (define-module (radix combinators) #:use-module (srfi srfi-26) + #:use-module (ice-9 curried-definitions) #:use-module (ice-9 match) - #:export (all? - any? + #:export (all-of + any-of conjoin disjoin inclusive-disjoin)) -(define (all? pred lst) +(define ((all-of pred) lst) (null? (filter (negate pred) lst))) -(define (any? pred lst) +(define ((any-of pred) lst) (cond ((null? lst) #f) ((pred (car lst)) #t) (else (any? pred (cdr lst))))) #| (conjoin (list (conjoin '()) predicates)) = (conjoin predicates) |# -(define (conjoin . 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)))))) +(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))))) #| (disjoin (list (disjoin '()) predicates)) = (disjoin predicates) |# -(define (disjoin . predicates) - (lambda args - (if (null? predicates) #f - (null? (cdr (filter (cut apply <> args) - predicates)))))) +(define ((disjoin . predicates) . args) + (if (null? predicates) #f + (= 1 (length (filter (cut apply <> args) + predicates))))) -(define (inclusive-disjoin . predicates) - (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 ((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)))))