commit 8e460716ed5611f0c61b4deb8c6c8af070d1438b
parent ff12ed2af404494962f579c55db8c49c59171ccc
Author: Georges Dupéron <georges.duperon@gmail.com>
Date: Tue, 30 Aug 2016 23:06:00 +0200
Speed up --check-pkg-deps
Diffstat:
2 files changed, 67 insertions(+), 52 deletions(-)
diff --git a/.travis.yml b/.travis.yml
@@ -50,6 +50,7 @@ before_script:
# packages without it getting stuck on a confirmation prompt.
script:
- raco test -x -p extensible-parser-specifications
+ - raco setup --check-pkg-deps --no-zo --no-launcher --no-install --no-post-install --no-docs --pkgs extensible-parser-specifications
after_success:
- raco setup --check-pkg-deps --pkgs extensible-parser-specifications
diff --git a/private/define-syntax+simple-api.rkt b/private/define-syntax+simple-api.rkt
@@ -8,22 +8,36 @@
(for-syntax racket/base
syntax/parse
racket/stxparam
- racket/syntax)
- (for-meta 2
- racket/base
- syntax/parse
- racket/syntax
- phc-toolkit/untyped
- (prefix-in syntax/parse: syntax/parse/private/residual-ct)))
+ racket/syntax
+ phc-toolkit/untyped)
+ (for-meta 2 (prefix-in syntax/parse: syntax/parse/private/residual-ct))
+ (for-meta 2 racket/base)
+ (for-meta 2 syntax/parse)
+ (for-meta 2 racket/syntax)
+ (for-meta 2 phc-toolkit/untyped))
-(define-simple-macro (define-syntax/parse+simple [name . args] . body)
- #:with name-forward (format-id #'name "~a-forward-attributes" #'name)
- #:with tmp-forward (format-id #'tmp "~a-forward-attributes" #'tmp)
- (begin
- (begin-for-syntax
- (define/syntax-parse+simple [tmp . args] . body)
- (define-syntax name-forward (make-rename-transformer #'tmp-forward)))
- (define-syntax name tmp)))
+#;(define-syntax/case (define-syntax/parse+simple [name . args] . body) ()
+ (with-format-ids/inject-binders
+ ([name-forward #'name "~a-forward-attributes" #'name]
+ [tmp-forward #'tmp "~a-forward-attributes" #'tmp])
+ #'(begin
+ (begin-for-syntax
+ (inject-sub-range-binders ...
+ (define/syntax-parse+simple [tmp . args] . body)
+ (define-syntax name-forward (make-rename-transformer #'tmp-forward))))
+ (define-syntax name tmp))))
+
+(define-syntax/parse (define-syntax/parse+simple (~optional (~and two #:2))
+ [name . args] . body)
+ (with-format-ids/inject-binders
+ ([name-forward #'name "~a-forward-attributes" #'name]
+ [tmp-forward #'tmp "~a-forward-attributes" #'tmp])
+ #'(begin
+ (begin-for-syntax
+ (inject-sub-range-binders ...
+ (define/syntax-parse+simple [tmp . args] . body)
+ (define-syntax name-forward (make-rename-transformer #'tmp-forward))))
+ (define-syntax name tmp))))
(begin-for-syntax
(define-syntax (define/syntax-parse+simple stx)
@@ -47,39 +61,39 @@
[(_ [name (~var cls (static syntax/parse:stxclass? "a syntax class"))]
. body)
#:with colon-stxclass (format-id #'cls ":~a" #'cls)
- #:with name-forward (format-id #'name "~a-forward-attributes" #'name)
- (with-disappeared-uses
- (let ()
- (define c (syntax-local-value/record #'cls syntax/parse:stxclass?))
- (define attrs (syntax/parse:stxclass-attrs c))
- (define/with-syntax (attr-name …) (map syntax/parse:attr-name attrs))
- (define/with-syntax (attr-name/ctx …)
- (stx-map (λ (a) (datum->syntax #'body (syntax-e a)))
- #'(attr-name …)))
- (define-temp-ids "~a/arg" (attr-name …))
- (define/with-syntax (attr-depth …)
- (map syntax/parse:attr-depth attrs))
- #'(begin
- (define (name stx2)
- (syntax-parameterize ([stx (make-rename-transformer #'stx2)])
- (syntax-parse stx2
- [(_ . colon-stxclass) . body])))
- (define (private-simple-api stx/arg attr-name/arg …)
- (syntax-parameterize ([stx (make-rename-transformer #'stx/arg)])
- (syntax-parse #'nothing
- [(~bind [(attr-name/ctx attr-depth) attr-name/arg] …)
- . body])))
- (define-syntax (name-forward stx3)
- (syntax-case stx3 ()
- [(_)
- #`(private-simple-api
- stx
- (attribute #,(datum->syntax stx3 'attr-name))
- …)]
- [(_ forward-args-prefix)
- #`(private-simple-api
- stx
- (attribute #,(format-id stx3 "~a.~a"
- #'forward-args-prefix
- 'attr-name))
- …)])))))])))
-\ No newline at end of file
+ (with-arrows
+ (define/with-syntax name-forward
+ (format-id/record #'name "~a-forward-attributes" #'name))
+ (define c (syntax-local-value/record #'cls syntax/parse:stxclass?))
+ (define attrs (syntax/parse:stxclass-attrs c))
+ (define/with-syntax (attr-name …) (map syntax/parse:attr-name attrs))
+ (define/with-syntax (attr-name/ctx …)
+ (stx-map (λ (a) (datum->syntax #'body (syntax-e a)))
+ #'(attr-name …)))
+ (define-temp-ids "~a/arg" (attr-name …))
+ (define/with-syntax (attr-depth …)
+ (map syntax/parse:attr-depth attrs))
+ #'(begin
+ (define (name stx2)
+ (syntax-parameterize ([stx (make-rename-transformer #'stx2)])
+ (syntax-parse stx2
+ [(_ . colon-stxclass) . body])))
+ (define (private-simple-api stx/arg attr-name/arg …)
+ (syntax-parameterize ([stx (make-rename-transformer #'stx/arg)])
+ (syntax-parse #'nothing
+ [(~bind [(attr-name/ctx attr-depth) attr-name/arg] …)
+ . body])))
+ (define-syntax (name-forward stx3)
+ (syntax-case stx3 ()
+ [(_)
+ #`(private-simple-api
+ stx
+ (attribute #,(datum->syntax stx3 'attr-name))
+ …)]
+ [(_ forward-args-prefix)
+ #`(private-simple-api
+ stx
+ (attribute #,(format-id stx3 "~a.~a"
+ #'forward-args-prefix
+ 'attr-name))
+ …)]))))])))
+\ No newline at end of file
