suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add contracts to the "with-" macros in redex/pict

Browse Source
This commit is contained in:
Robby Findler 2013-03-30 09:14:16 -05:00
parent c8c6341970
commit 5a85af78ac
3 changed files with 42 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
collects/redex/private/core-layout.rkt
View File

@ -11,8 +11,10 @@
racket/match
racket/draw
racket/class
racket/contract
(for-syntax racket/base))
(for-syntax racket/base
syntax/parse))
(define pink-code-font 'modern)
@ -68,10 +70,16 @@
(hole "[]"))))
(define-syntax (with-atomic-rewriter stx)
(syntax-case stx ()
[(_ name transformer e)
(syntax-parse stx
[(_ name transformer e:expr)
#:declare name
(expr/c #'symbol?
#:name "atomic-rewriter name")
#:declare transformer
(expr/c #'(or/c (-> pict?) string?)
#:name "atomic-rewriter rewrite")
#'(parameterize ([atomic-rewrite-table
(cons (list name transformer)
(cons (list name.c transformer.c)
(atomic-rewrite-table))])
e)]))
@ -102,24 +110,31 @@
the-name
(blank))))))))
(define-syntax-rule (with-compound-rewriter name rewriter body)
(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))])
body)]))
(define-syntax (with-compound-rewriters stx)
(syntax-parse stx
[(_ ([name rewriter] ...) body:expr)
#:declare name (expr/c #'symbol? #:name "compound-rewriter name")
#:declare rewriter (expr/c #'(-> (listof lw?)
(listof (or/c lw? string? pict?)))
#:name "compound-rewriter transformer")
#'(parameterize ([compound-rewrite-table
(append (reverse (list (list name rewriter.c) ...))
(compound-rewrite-table))])
body)]))
(define-syntax (with-unquote-rewriter stx)
(syntax-case stx ()
[(_ transformer e)
#'(parameterize ([current-unquote-rewriter transformer])
(syntax-parse stx
[(_ transformer e:expr)
#:declare transformer
(expr/c #'(-> lw? lw?)
#:name "unquote-rewriter")
#'(parameterize ([current-unquote-rewriter transformer.c])
e)]))
(define current-unquote-rewriter (make-parameter values))
;; token = string-token | spacer-token | pict-token | align-token | up-token

12
collects/redex/scribblings/ref.scrbl
View File

@ -2927,14 +2927,12 @@ To replace the pink code, use:
@defform[(with-unquote-rewriter proc expression)]{
It installs @racket[proc] the current unqoute rewriter and
evaluates expression. If that expression computes any picts,
Installs @racket[proc] as the current unquote rewriter and
evaluates @racket[expression]. If that expression computes any picts,
the unquote rewriter specified is used to remap them.
The @racket[proc] should be a function of one argument. It receives
a @racket[lw] struct as an argument and should return
another @racket[lw] that contains a rewritten version of the
code.
The @racket[proc] must match the contract @racket[(-> lw? lw?)].
Its result should be the rewritten version version of the input.
}
@defform[(with-atomic-rewriter name-symbol
@ -2947,7 +2945,7 @@ string-or-pict-returning-thunk (applied, in the case of a
thunk), during the evaluation of expression.
@racket[name-symbol] is expected to evaluate to a symbol. The value
of string-or-thunk-returning-pict is used whever the symbol
of string-or-thunk-returning-pict is used whenever the symbol
appears in a pattern.
}

7
collects/redex/tests/bitmap-test.rkt
View File

@ -243,8 +243,11 @@
(list-ref lws 4)
"}"))
(btest (with-compound-rewriter 'subst subst-rw
(render-metafunction subst))
(btest (with-atomic-rewriter
'number "number" ;; this rewriter has no effect; here to test that path in the code
(with-compound-rewriter
'subst subst-rw
(render-metafunction subst)))
"metafunction-subst.png")