syntax/parse: fixed bugs (thanks samth)
Please propagate this to the release branch. svn: r17756
This commit is contained in:
parent
a86337375d
commit
ef138249f4
|
@ -973,7 +973,7 @@
|
|||
(define (check-sc-expr x)
|
||||
(syntax-case x ()
|
||||
[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)]))
|
||||
(syntax-case stx ()
|
||||
[(rx sc)
|
||||
|
|
|
@ -104,6 +104,7 @@ means specifically @tech{@Spattern}.
|
|||
(~not S-pattern)
|
||||
#((unsyntax @svar[pattern-part]) ...)
|
||||
#s(prefab-struct-key (unsyntax @svar[pattern-part]) ...)
|
||||
#&@#,svar[S-pattern]
|
||||
(~rest S-pattern)
|
||||
(@#,ref[~describe s] expr S-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)]{
|
||||
|
||||
Matches just like @scheme[S-pattern]. The @scheme[~rest] pattern form
|
||||
|
|
|
@ -182,13 +182,31 @@
|
|||
(syntax-parse #'(+) #:literals ([plus +])
|
||||
[(plus) (void)])
|
||||
|
||||
(define-syntax-class (nat> n)
|
||||
#:description (format "nat > ~s" n)
|
||||
(define-syntax-class (Nat> n)
|
||||
#:description (format "Nat > ~s" n)
|
||||
(pattern x:nat #:fail-unless (> (syntax-e #'x) n) #f))
|
||||
(syntax-parse #'(1 2 3)
|
||||
[(a:nat b0:nat c0:nat)
|
||||
#:with b #'b0
|
||||
#:declare b (nat> (syntax-e #'a))
|
||||
#:declare b (Nat> (syntax-e #'a))
|
||||
#:with c #'c0
|
||||
#:declare c (nat> (syntax-e #'b0))
|
||||
#:declare c (Nat> (syntax-e #'b0))
|
||||
(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"))
|
||||
|
|
Loading…
Reference in New Issue
Block a user