From e209bfe130157bf30eb13f27ebabddb580153cb4 Mon Sep 17 00:00:00 2001 From: Dane Johnson Date: Fri, 22 Nov 2024 09:27:07 -0600 Subject: [PATCH] Add "upply" (U-shaped apply, names are hard) --- d-.scm | 5 +++++ test.scm | 5 +++++ 2 files changed, 10 insertions(+) diff --git a/d-.scm b/d-.scm index b82b505..40f1afc 100644 --- a/d-.scm +++ b/d-.scm @@ -12,6 +12,7 @@ partial argmin iterate + upply generator macro-expand)) @@ -72,6 +73,10 @@ v (iterate (1- n) f (f v)))) +(define (upply a b cmp . fs) + (let ([arm-f (apply compose fs)]) + (cmp (arm-f a) (arm-f b)))) + ;; Shamelessly ripped from https://wingolog.org/archives/2013/02/25/on-generators (define (make-generator f) (define tag (make-prompt-tag)) diff --git a/test.scm b/test.scm index 8df0b51..d7b3525 100644 --- a/test.scm +++ b/test.scm @@ -64,6 +64,11 @@ (define value (iterate 2 1+ 3)) (assert-equal 5 value))) +(define-test-suite "upply" + (define-test "test" + (define value (upply -3 5 = abs 1-)) + (assert-equal #t value))) + (define-test-suite "generator" (define-test "test" (define number-generator