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)
#: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)
(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)))))
(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)
(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)))))
(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)))