combinators: Add documentation to procedures

modules/radix/combinators.scm

@@ -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)
+(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.
+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)
-(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)
+  "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)
+(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)))