From 728926e891ebb8bd7104f61b2e1e2f1288bdca13 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Wed, 16 Dec 2020 23:09:35 +0100
Subject: [PATCH] utils: Add multi-compose.

---
 scribblings/utils.scrbl | 15 +++++++++++++++
 utils.rkt               | 22 ++++++++++++++++++++--
 2 files changed, 35 insertions(+), 2 deletions(-)

diff --git a/scribblings/utils.scrbl b/scribblings/utils.scrbl
index b59123b..8f88ae7 100644
--- a/scribblings/utils.scrbl
+++ b/scribblings/utils.scrbl
@@ -149,6 +149,21 @@ fancy-add1
 (fancy-add1 "1")
 ]}
 
+@defform[(multi-compose func ...)
+	 #:contracts ([func expression])]{
+
+Expands to a code applying @racket[compose] in a pairwise manner to the given
+expressions.  For example, @racket[(multi-compose f1 f2 f3 f4)] expands to
+@racket[(compose f1 (compose f2 (compose f3 f4)))].
+
+@examples[#:eval utils-evaluator
+((multi-compose add1
+                (λ ([x : Number]) (* x 3))
+                add1
+                (λ ([x : Number]) (+ x 2)))
+	3)
+]}
+
 @section{Org-mode interoperability}
 
 Org-mode supports laying out the output of code blocks as tables, which is very
diff --git a/utils.rkt b/utils.rkt
index 135fceb..4a78076 100644
--- a/utils.rkt
+++ b/utils.rkt
@@ -1,13 +1,14 @@
 #lang typed/racket
 
-(require (for-syntax syntax/parse racket/list))
+(require (for-syntax syntax/parse racket/list
+                     (only-in racket/match match-define)))
 
 (provide Variable VariableMapping GeneralPair
          eval-with eval1-with
          extract-symbols
          any->string stringify-variable-mapping string->any map-sexp
          read-org-sexp unorg unstringify-pairs compose-n compose-3 compose-4
-         read-org-variable-mapping unorgv
+         multi-compose read-org-variable-mapping unorgv
          ;; Syntax
          auto-hash-ref/explicit auto-hash-ref/:)
 
@@ -146,6 +147,23 @@
 (define (compose-4 f1 f2 f3 f4)
   (λ (x) (f1 (f2 (f3 (f4 x))))))
 
+(define-syntax (multi-compose stx)
+  (syntax-parse stx
+    [(_ f1 f2 funcs ...)
+     (match-define (list fn fn-1 fs ...)
+       (reverse (cons #'f1 (cons #'f2 (syntax->list #'(funcs ...))))))
+     (datum->syntax stx (for/fold ([sexp `(compose ,fn-1 ,fn)])
+                                  ([f (in-list fs)])
+                          `(compose ,f ,sexp)))]))
+
+(module+ test
+  (check-equal? ((multi-compose add1
+                                (λ ([x : Number]) (* x 3))
+                                add1
+                                (λ ([x : Number]) (+ x 2)))
+                 3)
+                19))
+
 
 ;;; =========================
 ;;; Org-mode interoperability