utils: Add multi-compose.

This commit is contained in:
Sergiu Ivanov 2020-12-16 23:09:35 +01:00
parent 3bb695e2cf
commit 728926e891
2 changed files with 35 additions and 2 deletions

View File

@ -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

View File

@ -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