diff --git a/d-.scm b/d-.scm index 7f3bae0..b8f48b6 100644 --- a/d-.scm +++ b/d-.scm @@ -12,6 +12,7 @@ argmin iterate upply + conjoin distinct? generator macro-expand @@ -69,18 +70,30 @@ vals)) (define (iterate n f v) + "Repeatedly call f on values returned from (f v)" (if (zero? n) v (iterate (1- n) f (f v)))) (define (upply a b cmp . fs) + "U-shapped apply, apply fs to a and b as in compose, then apply cmp to both results" (let ([arm-f (apply compose fs)]) (cmp (arm-f a) (arm-f b)))) +(define (conjoin . preds) + "Returns a procedure that applies each pred to a single value, and returns #t if all return a truthy value. With no preds returns a one arg function that always returns true" + (if (null? preds) + (lambda (x) #t) + (lambda (x) + (if ((car preds) x) + ((apply conjoin (cdr preds)) x) + #f)))) + (define (distinct? . a) + "Are all values distinct, as in equal?" (if (or (null? a) (null? (cdr a))) #t - (and (not (any (lambda (x) (eq? (car a) x)) (cdr a))) + (and (not (any (lambda (x) (equal? (car a) x)) (cdr a))) (apply distinct? (cdr a))))) ;; Shamelessly ripped from https://wingolog.org/archives/2013/02/25/on-generators @@ -96,6 +109,7 @@ value)))) (define-syntax generator + ;; generator with an anaphoric yield (lambda (x) (syntax-case x () [(generator expr ...) diff --git a/test.scm b/test.scm index 2547dd7..93e1141 100644 --- a/test.scm +++ b/test.scm @@ -63,6 +63,13 @@ (define value (upply -3 5 = abs 1-)) (assert-equal #t value))) +(define-test-suite "conjoin" + (define-test "test" + (assert-equal #t ((conjoin negative? odd? rational?) -3)) + (assert-equal #f ((conjoin negative? odd? rational?) -4))) + (define-test "vacuous" + (assert-equal #t ((conjoin) '(some donkus))))) + (define-test-suite "generator" (define-test "test" (define number-generator