combinators: Add documentation to procedures

pull/1/head
Luis Guilherme Coelho 2024-01-03 00:37:18 -03:00
parent a12d3db825
commit c4c04d9359
No known key found for this signature in database
GPG Key ID: 1F2E76ACE3F531C8
1 changed files with 60 additions and 34 deletions

View File

@ -1,6 +1,4 @@
(define-module (radix combinators) (define-module (radix combinators)
#:use-module (srfi srfi-26)
#:use-module (ice-9 curried-definitions)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (all-of #:export (all-of
any-of any-of
@ -12,44 +10,72 @@
partial partial
swap)) swap))
(define ((all-of pred) lst) (define (all-of pred)
(null? (filter (negate 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))))
(define ((any-of pred) lst) (define (any-of pred)
(cond ((null? lst) #f) "Returns a procedure that takes a list LST and returns #t if any element of
((pred (car lst)) #t) LST satisfies pred."
(else (any? pred (cdr lst))))) (match-lambda
(() #f)
((head . tail)
(cond ((pred head) #t)
(else (any? pred tail))))))
#| (conjoin (list (conjoin '()) predicates)) = (conjoin predicates) |# (define (conjoin . predicates)
(define ((conjoin . predicates) . args) "Returns a procedure that is the conjuction of every predicate in PREDICATES.
(if (null? predicates) #t The returned procedure takes an arbitrary number of arguments, and returns #t
(match-let loop (((head-pred . tail-preds) predicates)) if these arguments satisfy every other predicate in PREDICATES."
(cond ((null? tail-preds) (apply head-pred args)) (lambda args
((apply head-pred args) (loop tail-preds)) (if (null? predicates) #t
(else #f))))) (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)
(define ((disjoin . predicates) . args) "Returns a procedure that is the inclusive disjunction of every predicate in
(if (null? predicates) #f PREDICATES. The returned procedure takes an arbitrary number of arguments, and
(= 1 (length (filter (cut apply <> args) returns #t if these arguments satisfy exactly one predicate in PREDICATES, and
predicates))))) #f otherwise."
(lambda args
(match (filter (partial (flip apply) args) predicates)
((_) #t)
(else #f))))
(define ((inclusive-disjoin . predicates) . args) (define (inclusive-disjoin . predicates)
(if (null? predicates) #f "Returns a procedure that is the inclusive disjunction of every predicate in
(match-let loop (((head-pred . tail-preds) predicates)) PREDICATES. The returned procedure takes an arbitrary number of arguments, and
(cond ((null? tail-preds) (apply head-pred args)) returns #t if these arguments satifsy at least one predicate in PREDICATES, and
((not (apply head-pred args)) (loop tail-preds)) #f otherwise."
(else #f))))) (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) (define (partial proc . args)
(apply proc (append 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))))
(define ((flip proc) . args) (define (flip proc)
(apply proc (reverse args))) "Returns a procedure that applies PROC to the reverse of ARGS."
(lambda args (apply proc (reverse args))))
(define ((swap proc) arg1 arg2 . args) (define ((swap proc) arg1 arg2 . more-args)
(apply proc arg2 arg1 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) (define ((juxt proc . more-procs) . args)
(map (lambda (proc) (apply proc arg more-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))) (cons proc more-procs)))