diff --git a/private/define-syntax+simple-api.rkt b/private/define-syntax+simple-api.rkt index eb1cc03..8fc6433 100644 --- a/private/define-syntax+simple-api.rkt +++ b/private/define-syntax+simple-api.rkt @@ -33,35 +33,37 @@ #:with colon-stxclass (format-id #'cls ":~a" #'cls) #:with name-forward (format-id #'name "~a-forward-attributes" #'name) (with-disappeared-uses - (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 - [(name 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 + (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 + [(name 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