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

support boxes in syntax patterns and templates

Browse Source 
Also, `datum-case' and `datum' from `syntax/datum'.
This commit is contained in:
Matthew Flatt 2013-03-21 08:50:03 -06:00
parent 899c742c56
commit acd6764019
7 changed files with 73 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/racket/private/sc.rkt
View File

@ -361,6 +361,20 @@
#f)))
did-var?
#f)))))]
[(stx-box? p)
(let*-values ([(content) (unbox (syntax-e p))]
[(match-content did-var? <false>) (m&e content content use-ellipses? last? #f)])
(if just-vars?
(values match-content #f #f)
(values
(if interp-box
(vector 'box match-content)
`(lambda (e)
(if ,(if s-exp? '(box? e) '(stx-box? e))
,(app match-content `(unbox ,(if s-exp? 'e '(syntax-e e))))
#f)))
did-var?
#f)))]
[(and (syntax? p)
(prefab-struct-key (syntax-e p)))
=>
@ -511,6 +525,7 @@
[(syntax? p) (loop (syntax-e p))]
[(pair? p) (or (loop (car p)) (loop (cdr p)))]
[(vector? p) (loop (vector->list p))]
[(box? p) (loop (unbox p))]
[(struct? p) (loop (struct->vector p))]
[else #f]))
(pfx-loop (string-append "_" pfx))
@ -665,6 +680,13 @@
(list->vector (,(if s-exp? 'values 'stx->list) ,(apply-to-r e))))
;; variables were hashed
(void)))]
[(stx-box? p)
(let ([e (expander (unbox (syntax-e p)) proto-r p use-ellipses? use-tail-pos hash! #t)])
(if proto-r
`(lambda (r)
(box (,(if s-exp? 'values 'syntax-e) ,(apply-to-r e))))
;; variables were hashed
(void)))]
[(and (syntax? p)
(struct? (syntax-e p))
(prefab-struct-key (syntax-e p)))
@ -946,6 +968,8 @@
(list p))]
[(stx-vector? p #f)
(sub (vector->list (syntax-e p)) use-ellipses?)]
[(stx-box? p)
(sub (unbox (syntax-e p)) use-ellipses?)]
[(and (syntax? p)
(prefab-struct-key (syntax-e p)))
(sub (cdr (vector->list (struct->vector (syntax-e p)))) use-ellipses?)]

10
collects/racket/private/stx.rkt
View File

@ -122,6 +122,15 @@
(lambda (p pos)
(vector-ref (syntax-e p) pos)))
;; a syntax box?
(define-values (stx-box?)
(lambda (p)
(if (syntax? p)
(if (box? (syntax-e p))
#t
#f)
#f)))
(define-values (stx-prefab?)
(lambda (key v)
(if (syntax? v)
@ -203,6 +212,7 @@
(#%provide identifier? stx-null? stx-null/#f stx-pair? stx-list?
stx-car stx-cdr stx->list
stx-vector? stx-vector-ref
stx-box?
stx-prefab?
stx-check/esc cons/#f append/#f
stx-rotate stx-rotate*

6
collects/racket/private/stxcase.rkt
View File

@ -256,6 +256,12 @@
m
(append m body))
body)))))))])))]
[(eq? i 'box)
(let ([match-content (vector-ref pat 1)])
(and (if s-exp?
(box? e)
(stx-box? e))
(loop match-content (unbox (if s-exp? e (syntax-e e))) cap)))]
[(eq? i 'prefab)
(and (if s-exp?
(equal? (vector-ref pat 1) (prefab-struct-key e))

13
collects/scribblings/reference/stx-patterns.scrbl
View File

@ -23,6 +23,7 @@
(pattern ... pattern ellipsis pattern ... . pattern)
(code:line #,(tt "#")(pattern ...))
(code:line #,(tt "#")(pattern ... pattern ellipsis pattern ...))
(code:line #,(tt "#&")pattern)
(code:line #,(tt "#s")(key-datum pattern ...))
(code:line #,(tt "#s")(key-datum pattern ... pattern ellipsis pattern ...))
(ellipsis stat-pattern)
@ -128,6 +129,11 @@ A syntax object matches a @racket[pattern] as follows:
but matching a vector syntax object whose elements match the
corresponding sub-@racket[pattern]s.}
@specsubform[(code:line #,(tt "#&")pattern)]{
Matches a box syntax object whose content matches the
@racket[pattern].}
@specsubform[(code:line #,(tt "#s")(key-datum pattern ...))]{
Like a @racket[(pattern ...)] pattern, but matching a @tech{prefab}
@ -265,6 +271,7 @@ the individual @racket[stx-expr].
(template-elem ...)
(template-elem ...+ . template)
(code:line #,(tt "#")(template-elem ...))
(code:line #,(tt "#&")template)
(code:line #,(tt "#s")(key-datum template-elem ...))
(ellipsis stat-template)
const]
@ -273,6 +280,7 @@ the individual @racket[stx-expr].
(stat-template ...)
(stat-template ... . stat-template)
(code:line #,(tt "#")(stat-template ...))
(code:line #,(tt "#&")stat-template)
(code:line #,(tt "#s")(key-datum stat-template ...))
const]
[ellipsis #,lit-ellipsis])]{
@ -352,6 +360,11 @@ Template forms produce a syntax object as follows:
Like the @racket[(template-elem ...)] form, but producing a syntax
object whose datum is a vector instead of a list.}
@specsubform[(code:line #,(tt "#&")template)]{
Produces a syntax object whose datum is a box holding the
syntax object produced by @racket[template].}
@specsubform[(code:line #,(tt "#s")(key-datum template-elem ...))]{
Like the @racket[(template-elem ...)] form, but producing a syntax

6
collects/tests/racket/stx.rktl
View File

@ -136,6 +136,12 @@
((ull (+ nn mm) ((- n m) (- p q)))
(ull (+ pp qq) ((- nn mm) (- pp qq))))))
(test 5 syntax-e (syntax-case #'#&5 ()
[#&x #'x]))
(test '(0 1 2 3 4) syntax->datum
(syntax-case #'#&(1 2 3) ()
[#&(x ...) #'(0 x ... 4)]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test basic expansion and property propagation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

12
collects/tests/syntax/datum.rkt
View File

@ -30,6 +30,18 @@
(datum-case '#(1 2 3) ()
[#(a b c) (datum (c b a))]))
(test 5
(datum-case '#&5 ()
[#&x (datum x)]))
(test '(3 2 1)
(datum-case '#&(1 2 3) ()
[#&(a b c) (datum (c b a))]))
(test '(5)
(datum-case '#&((((5)))) ()
[#&((((x)))) (datum (x))]))
(test '(3 2 1)
(datum-case '#s(q 1 2 3) ()
[#s(q a b c) (datum (c b a))]))

2
doc/release-notes/racket/HISTORY.txt
View File

@ -1,11 +1,13 @@
Version 5.3.3.7
Added module-compiled-cross-phase-persistent?
Added 'so-mode mode for system-type
Changed syntax-case, etc. to support box patterns
ffi/unsafe: changed ffi-lib to use (system-type 'so-mode)
slideshow/balloon: added balloon-enable-3d
slideshow: added interactive
scribble/manual: added #:id option to defthing
scribble/srcdoc: added begin-for-doc
syntax/datum: Changed datum-case to support box patterns
syntax-color: added special support for dont-stop values;
this change is backwards incompatible for code that calls
lexers and may call unknown lexers