diff --git a/collects/syntax/private/stxparse/rep.ss b/collects/syntax/private/stxparse/rep.ss index e5d993b059..b0a31a43c3 100644 --- a/collects/syntax/private/stxparse/rep.ss +++ b/collects/syntax/private/stxparse/rep.ss @@ -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) diff --git a/collects/syntax/scribblings/parse-patterns.scrbl b/collects/syntax/scribblings/parse-patterns.scrbl index 17a999542f..81cdceb011 100644 --- a/collects/syntax/scribblings/parse-patterns.scrbl +++ b/collects/syntax/scribblings/parse-patterns.scrbl @@ -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 diff --git a/collects/tests/stxparse/stxclass.ss b/collects/tests/stxparse/stxclass.ss index d88d7fc9d5..7f93ec1260 100644 --- a/collects/tests/stxparse/stxclass.ss +++ b/collects/tests/stxparse/stxclass.ss @@ -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"))