Adds with-compound-rewriters typesetting form

This commit is contained in:
Casey Klein 2011-08-09 08:45:07 -05:00
parent 29ffea3b76
commit 88cd7cd303
4 changed files with 19 additions and 13 deletions

View File

@ -141,6 +141,7 @@
[just-after (-> (or/c pict? string? symbol?) lw? lw?)]) [just-after (-> (or/c pict? string? symbol?) lw? lw?)])
(provide with-unquote-rewriter (provide with-unquote-rewriter
with-compound-rewriter with-compound-rewriter
with-compound-rewriters
with-atomic-rewriter) with-atomic-rewriter)
(provide/contract (provide/contract

View File

@ -38,6 +38,7 @@
just-after just-after
with-unquote-rewriter with-unquote-rewriter
with-compound-rewriter with-compound-rewriter
with-compound-rewriters
with-atomic-rewriter with-atomic-rewriter
STIX? STIX?
white-bracket-sizing white-bracket-sizing
@ -98,13 +99,15 @@
the-name the-name
(blank)))))))) (blank))))))))
(define-syntax (with-compound-rewriter stx) (define-syntax-rule (with-compound-rewriter name rewriter body)
(syntax-case stx () (with-compound-rewriters ([name rewriter]) body))
[(_ name transformer e) (define-syntax with-compound-rewriters
#'(parameterize ([compound-rewrite-table (syntax-rules ()
(cons (list name transformer) [(_ ([name rewriter] ...) body)
(parameterize ([compound-rewrite-table
(append (reverse (list (list name rewriter) ...))
(compound-rewrite-table))]) (compound-rewrite-table))])
e)])) body)]))
(define-syntax (with-unquote-rewriter stx) (define-syntax (with-unquote-rewriter stx)
(syntax-case stx () (syntax-case stx ()

View File

@ -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? @defstruct[lw ([e (or/c string?
symbol? symbol?
pict? pict?

View File

@ -346,13 +346,11 @@
(define (rewrite-lookup lws) (define (rewrite-lookup lws)
(list "" (list-ref lws 2) "(" (list-ref lws 3) ")")) (list "" (list-ref lws 2) "(" (list-ref lws 3) ")"))
(test (with-compound-rewriter (test (with-compound-rewriters
'typeof rewrite-typeof (['typeof rewrite-typeof]
(with-compound-rewriter ['extend rewrite-extend]
'extend rewrite-extend ['lookup rewrite-lookup])
(with-compound-rewriter (render-judgment-form typeof))
'lookup rewrite-lookup
(render-judgment-form typeof))))
"stlc.png")) "stlc.png"))
(printf "bitmap-test.rkt: ") (printf "bitmap-test.rkt: ")