utils.rkt: Replace multi-compose by the implementation by Sorawee.
This commit is contained in:
parent
728926e891
commit
c92db58962
1 changed files with 6 additions and 8 deletions
14
utils.rkt
14
utils.rkt
|
@ -1,7 +1,6 @@
|
||||||
#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
|
||||||
|
@ -148,13 +147,12 @@
|
||||||
(λ (x) (f1 (f2 (f3 (f4 x))))))
|
(λ (x) (f1 (f2 (f3 (f4 x))))))
|
||||||
|
|
||||||
(define-syntax (multi-compose stx)
|
(define-syntax (multi-compose stx)
|
||||||
|
;; Implementation by Sorawee Porncharoenwase.
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
[(_ f1 f2 funcs ...)
|
[(_ f:expr g:expr)
|
||||||
(match-define (list fn fn-1 fs ...)
|
#'(compose f g)]
|
||||||
(reverse (cons #'f1 (cons #'f2 (syntax->list #'(funcs ...))))))
|
[(_ f:expr funcs:expr ...)
|
||||||
(datum->syntax stx (for/fold ([sexp `(compose ,fn-1 ,fn)])
|
#'(compose f (multi-compose funcs ...))]))
|
||||||
([f (in-list fs)])
|
|
||||||
`(compose ,f ,sexp)))]))
|
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(check-equal? ((multi-compose add1
|
(check-equal? ((multi-compose add1
|
||||||
|
|
Loading…
Reference in a new issue