diff --git a/collects/redex/pict.rkt b/collects/redex/pict.rkt index 62c20874b1..e925afb820 100644 --- a/collects/redex/pict.rkt +++ b/collects/redex/pict.rkt @@ -141,6 +141,7 @@ [just-after (-> (or/c pict? string? symbol?) lw? lw?)]) (provide with-unquote-rewriter with-compound-rewriter + with-compound-rewriters with-atomic-rewriter) (provide/contract diff --git a/collects/redex/private/core-layout.rkt b/collects/redex/private/core-layout.rkt index 8b0f8d3ec3..7afa950713 100644 --- a/collects/redex/private/core-layout.rkt +++ b/collects/redex/private/core-layout.rkt @@ -38,6 +38,7 @@ just-after with-unquote-rewriter with-compound-rewriter + with-compound-rewriters with-atomic-rewriter STIX? white-bracket-sizing @@ -98,13 +99,15 @@ the-name (blank)))))))) - (define-syntax (with-compound-rewriter stx) - (syntax-case stx () - [(_ name transformer e) - #'(parameterize ([compound-rewrite-table - (cons (list name transformer) + (define-syntax-rule (with-compound-rewriter name rewriter body) + (with-compound-rewriters ([name rewriter]) body)) + (define-syntax with-compound-rewriters + (syntax-rules () + [(_ ([name rewriter] ...) body) + (parameterize ([compound-rewrite-table + (append (reverse (list (list name rewriter) ...)) (compound-rewrite-table))]) - e)])) + body)])) (define-syntax (with-unquote-rewriter stx) (syntax-case stx () diff --git a/collects/redex/redex.scrbl b/collects/redex/redex.scrbl index 86212984eb..fd35a3293b 100644 --- a/collects/redex/redex.scrbl +++ b/collects/redex/redex.scrbl @@ -2620,6 +2620,10 @@ explanation of logical-space): }] } +@defform[(with-compound-rewriters ([name-symbol proc] ...) + expression)]{ +Shorthand for nested @racket[with-compound-rewriter] expressions.} + @defstruct[lw ([e (or/c string? symbol? pict? diff --git a/collects/redex/tests/bitmap-test.rkt b/collects/redex/tests/bitmap-test.rkt index 58e571a79d..068ac2e506 100644 --- a/collects/redex/tests/bitmap-test.rkt +++ b/collects/redex/tests/bitmap-test.rkt @@ -346,13 +346,11 @@ (define (rewrite-lookup lws) (list "" (list-ref lws 2) "(" (list-ref lws 3) ")")) - (test (with-compound-rewriter - 'typeof rewrite-typeof - (with-compound-rewriter - 'extend rewrite-extend - (with-compound-rewriter - 'lookup rewrite-lookup - (render-judgment-form typeof)))) + (test (with-compound-rewriters + (['typeof rewrite-typeof] + ['extend rewrite-extend] + ['lookup rewrite-lookup]) + (render-judgment-form typeof)) "stlc.png")) (printf "bitmap-test.rkt: ")