From a13b30d876ced6149eab8ca6ae896a096ded61ac Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Sat, 12 Dec 2020 23:24:46 +0100
Subject: [PATCH] utils: Add compose-n, compose-3, and compose-4.

---
 scribblings/utils.scrbl | 20 ++++++++++++++++++++
 utils.rkt               | 15 ++++++++++++++-
 2 files changed, 34 insertions(+), 1 deletion(-)

diff --git a/scribblings/utils.scrbl b/scribblings/utils.scrbl
index 8580bec..0c93812 100644
--- a/scribblings/utils.scrbl
+++ b/scribblings/utils.scrbl
@@ -199,6 +199,26 @@ element with @racket[string->any] or keeps it as is if it is not a string.
 (unstringify-pairs '(("a" . 1) ("b" . "(and a (not b))")))
 ]}
 
+@defproc[(compose-n [proc (-> a a)] ...) (-> a a)]{
+
+Compose an arbitrary number of functions of type @racket[(-> a a)].
+
+@examples[#:eval utils-evaluator
+((compose-n add1 add1 add1) 3)
+]}
+
+@defproc*[([(compose-3 [proc1 (-> c d)] [proc2 (-> b c)] [proc3 (-> a b)]) (-> a d)]
+           [(compose-4 [proc1 (-> d e)] [proc2 (-> c d)] [proc3 (-> b c)] [proc4 (-> a b)]) (-> a e)])]{
+
+@racket[compose-i] composes @racket[i] functions.  The rightmost function is
+applied first.
+
+@examples[#:eval utils-evaluator
+(define (s->n [x : String]) (cast (string->number x) Number))
+(define fancy-add1 (compose-3 print add1 s->n))
+fancy-add1
+(fancy-add1 "1")
+]}
 @section{Additional graph utilities}
 
 @section{Pretty printing}
diff --git a/utils.rkt b/utils.rkt
index 3805891..2f7b6a1 100644
--- a/utils.rkt
+++ b/utils.rkt
@@ -6,7 +6,7 @@
          eval-with eval1-with
          extract-symbols
          any->string stringify-variable-mapping string->any map-sexp
-         read-org-sexp unorg unstringify-pairs
+         read-org-sexp unorg unstringify-pairs compose-n compose-3 compose-4
          ;; Syntax
          auto-hash-ref/explicit auto-hash-ref/:)
 
@@ -224,3 +224,16 @@
                   '((a . 1) (b . (and a (not b)))))
     (check-equal? (unstringify-pairs '(("a" . 1) ("b" . "(and a (not b))")))
                   '((a . 1) (b . (and a (not b)))))))
+
+(: compose-n (All (a) (-> (-> a a) * (-> a a))))
+(define (compose-n . funcs)
+  (λ (x)
+    (for/foldr ([x x]) ([f funcs])
+      (f x))))
+
+(: compose-3 (All (a b c d) (-> (-> c d) (-> b c) (-> a b) (-> a d))))
+(define (compose-3 f1 f2 f3)
+  (λ (x) (f1 (f2 (f3 x)))))
+(: compose-4 (All (a b c d e) (-> (-> d e) (-> c d) (-> b c) (-> a b) (-> a e))))
+(define (compose-4 f1 f2 f3 f4)
+  (λ (x) (f1 (f2 (f3 (f4 x))))))