cristiancmoises
/
radix
mirror of https://codeberg.org/anemofilia/radix.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

fix: correct combinators for supporting more use-cases and be more readable

pull/1/head
anemofilia 2023-08-26 16:47:22 -03:00
parent 34ba4ca9fe
commit 2a845008da
No known key found for this signature in database
GPG Key ID: 5A8F3D62C87A2B33
2 changed files with 21 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
files/lf/.lfrc.swp
View File

Binary file not shown.

44
modules/radix/combinators.scm
View File

@ -1,41 +1,39 @@
(define-module (radix combinators) (define-module (radix combinators)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 curried-definitions)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (all? #:export (all-of
any? any-of
conjoin conjoin
disjoin disjoin
inclusive-disjoin)) inclusive-disjoin))
(define (all? pred lst) (define ((all-of pred) lst)
(null? (filter (negate pred) lst))) (null? (filter (negate pred) lst)))
(define (any? pred lst) (define ((any-of pred) lst)
(cond ((null? lst) #f) (cond ((null? lst) #f)
((pred (car lst)) #t) ((pred (car lst)) #t)
(else (any? pred (cdr lst))))) (else (any? pred (cdr lst)))))
#| (conjoin (list (conjoin '()) predicates)) = (conjoin predicates) |# #| (conjoin (list (conjoin '()) predicates)) = (conjoin predicates) |#
(define (conjoin . predicates) (define ((conjoin . predicates) . args)
(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))))))
#| (disjoin (list (disjoin '()) predicates)) = (disjoin predicates) |# #| (disjoin (list (disjoin '()) predicates)) = (disjoin predicates) |#
(define (disjoin . predicates) (define ((disjoin . predicates) . args)
(lambda args (if (null? predicates) #f
(if (null? predicates) #f (= 1 (length (filter (cut apply <> args)
(null? (cdr (filter (cut apply <> args) predicates)))))
predicates))))))
(define (inclusive-disjoin . predicates) (define ((inclusive-disjoin . predicates) . args)
(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))))))