utils: Add multi-compose.
This commit is contained in:
parent
3bb695e2cf
commit
728926e891
2 changed files with 35 additions and 2 deletions
|
@ -149,6 +149,21 @@ fancy-add1
|
||||||
(fancy-add1 "1")
|
(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}
|
@section{Org-mode interoperability}
|
||||||
|
|
||||||
Org-mode supports laying out the output of code blocks as tables, which is very
|
Org-mode supports laying out the output of code blocks as tables, which is very
|
||||||
|
|
22
utils.rkt
22
utils.rkt
|
@ -1,13 +1,14 @@
|
||||||
#lang typed/racket
|
#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
|
(provide Variable VariableMapping GeneralPair
|
||||||
eval-with eval1-with
|
eval-with eval1-with
|
||||||
extract-symbols
|
extract-symbols
|
||||||
any->string stringify-variable-mapping string->any map-sexp
|
any->string stringify-variable-mapping string->any map-sexp
|
||||||
read-org-sexp unorg unstringify-pairs compose-n compose-3 compose-4
|
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
|
;; Syntax
|
||||||
auto-hash-ref/explicit auto-hash-ref/:)
|
auto-hash-ref/explicit auto-hash-ref/:)
|
||||||
|
|
||||||
|
@ -146,6 +147,23 @@
|
||||||
(define (compose-4 f1 f2 f3 f4)
|
(define (compose-4 f1 f2 f3 f4)
|
||||||
(λ (x) (f1 (f2 (f3 (f4 x))))))
|
(λ (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
|
;;; Org-mode interoperability
|
||||||
|
|
Loading…
Reference in a new issue