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

syntax/parse: fixed bugs (thanks samth)

Browse Source 
Please propagate this to the release branch.

svn: r17756
This commit is contained in:
Ryan Culpepper 2010-01-19 21:03:51 +00:00
parent a86337375d
commit ef138249f4
3 changed files with 35 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/syntax/private/stxparse/rep.ss
View File

@ -973,7 +973,7 @@
(define (check-sc-expr x) (define (check-sc-expr x)
(syntax-case x () (syntax-case x ()
[sc (identifier? #'sc) (list #'sc null)] [sc (identifier? #'sc) (list #'sc null)]
[(sc arg ...) (identifier? #'sc) (list #'sc #'(arg ...))] [(sc arg ...) (identifier? #'sc) (list #'sc (syntax->list #'(arg ...)))]
[_ (raise-syntax-error #f "expected syntax class use" ctx x)])) [_ (raise-syntax-error #f "expected syntax class use" ctx x)]))
(syntax-case stx () (syntax-case stx ()
[(rx sc) [(rx sc)

12
collects/syntax/scribblings/parse-patterns.scrbl
View File

@ -104,6 +104,7 @@ means specifically @tech{@Spattern}.
(~not S-pattern) (~not S-pattern)
#((unsyntax @svar[pattern-part]) ...) #((unsyntax @svar[pattern-part]) ...)
#s(prefab-struct-key (unsyntax @svar[pattern-part]) ...) #s(prefab-struct-key (unsyntax @svar[pattern-part]) ...)
#&@#,svar[S-pattern]
(~rest S-pattern) (~rest S-pattern)
(@#,ref[~describe s] expr S-pattern) (@#,ref[~describe s] expr S-pattern)
A-pattern] A-pattern]
@ -515,6 +516,17 @@ key and whose sequence of fields, when considered as a list, match the
] ]
} }
@specsubform[#&@#,svar[S-pattern]]{
Matches a term that is a box whose contents matches the inner
@tech{@Spattern}.
@myexamples[
(syntax-parse #'#&5
[#&n:nat 'ok])
]
}
@specsubform[(#, @defhere[~rest] S-pattern)]{ @specsubform[(#, @defhere[~rest] S-pattern)]{
Matches just like @scheme[S-pattern]. The @scheme[~rest] pattern form Matches just like @scheme[S-pattern]. The @scheme[~rest] pattern form

26
collects/tests/stxparse/stxclass.ss
View File

@ -182,13 +182,31 @@
(syntax-parse #'(+) #:literals ([plus +]) (syntax-parse #'(+) #:literals ([plus +])
[(plus) (void)]) [(plus) (void)])
(define-syntax-class (nat> n) (define-syntax-class (Nat> n)
#:description (format "nat > ~s" n) #:description (format "Nat > ~s" n)
(pattern x:nat #:fail-unless (> (syntax-e #'x) n) #f)) (pattern x:nat #:fail-unless (> (syntax-e #'x) n) #f))
(syntax-parse #'(1 2 3) (syntax-parse #'(1 2 3)
[(a:nat b0:nat c0:nat) [(a:nat b0:nat c0:nat)
#:with b #'b0 #:with b #'b0
#:declare b (nat> (syntax-e #'a)) #:declare b (Nat> (syntax-e #'a))
#:with c #'c0 #:with c #'c0
#:declare c (nat> (syntax-e #'b0)) #:declare c (Nat> (syntax-e #'b0))
(void)]) (void)])
(define-syntax-class (nat> bound)
#:opaque
#:description (format "natural number greater than ~s" bound)
(pattern n:nat
#:when (> (syntax-e #'n) bound)))
(define-conventions nat-convs
[N (nat> 0)])
(syntax-parse #'(5 4) #:conventions (nat-convs)
[(N ...) (void)])
(let/ec escape
(with-handlers ([exn? (compose escape void)])
(syntax-parse #'(4 -1) #:conventions (nat-convs)
[(N ...) (void)]))
(error 'test-conv1 "didn't work"))