diff --git a/collects/syntax/private/stxparse/minimatch.ss b/collects/syntax/private/stxparse/minimatch.ss index 759274ae71..863734995c 100644 --- a/collects/syntax/private/stxparse/minimatch.ss +++ b/collects/syntax/private/stxparse/minimatch.ss @@ -1,14 +1,23 @@ #lang scheme/base -(require (for-syntax scheme/base)) +(require (for-syntax scheme/base scheme/path)) (provide match) -(define-syntax-rule (match stx clause ...) - (let ([x stx]) (match-c x clause ...))) +(define-syntax (match stx) + (syntax-case stx () + [(match e clause ...) + #`(let ([x e]) + (match-c x + clause ... + [_ (error 'minimatch "match at ~s:~s:~s failed: ~e" + '#,(syntax-source stx) + '#,(syntax-line stx) + '#,(syntax-column stx) + x)]))])) (define-syntax match-c (syntax-rules () [(match-c x) - (error 'minimatch "match failed: ~s" x)] + (error 'minimatch)] [(match-c x [pattern result ...] clause ...) (let ([fail (lambda () (match-c x clause ...))]) (match-p x pattern (let () result ...) (fail)))])) diff --git a/collects/syntax/private/stxparse/parse.ss b/collects/syntax/private/stxparse/parse.ss index 6fb62809bb..cc5a54cddf 100644 --- a/collects/syntax/private/stxparse/parse.ss +++ b/collects/syntax/private/stxparse/parse.ss @@ -216,7 +216,7 @@ k)) (fail x #:expect result #:fce fc)))] [#s(pat:datum attrs datum) - #`(let ([d (syntax-e x)]) + #`(let ([d (syntax->datum x)]) (if (equal? d (quote datum)) k (fail x diff --git a/collects/syntax/private/stxparse/rep.ss b/collects/syntax/private/stxparse/rep.ss index 7fbedbe9e9..2089749bb6 100644 --- a/collects/syntax/private/stxparse/rep.ss +++ b/collects/syntax/private/stxparse/rep.ss @@ -76,6 +76,7 @@ (quote-syntax ||) (quote-syntax ...) (quote-syntax ~var) + (quote-syntax ~datum) (quote-syntax ~literal) (quote-syntax ~and) (quote-syntax ~or) @@ -86,7 +87,6 @@ (quote-syntax ~optional) (quote-syntax ~bounds) (quote-syntax ~rest) - (quote-syntax ~struct) (quote-syntax ~describe) (quote-syntax ~!) (quote-syntax ~bind) @@ -297,7 +297,7 @@ [(not allow-head?) (ghost-pattern->single-pattern x)] [else (wrong-syntax stx "action pattern not allowed here")])) - (syntax-case stx (~var ~literal ~and ~or ~not ~rest ~struct ~describe + (syntax-case stx (~var ~literal ~datum ~and ~or ~not ~rest ~describe ~seq ~optional ~! ~bind ~fail ~parse) [wildcard (wildcard? #'wildcard) @@ -319,6 +319,12 @@ [(~var . rest) (disappeared! stx) (parse-pat:var stx decls allow-head?)] + [(~datum . rest) + (disappeared! stx) + (syntax-case stx (~datum) + [(~datum d) + (create-pat:datum (syntax->datum #'d))] + [_ (wrong-syntax stx "bad ~~datum form")])] [(~literal . rest) (disappeared! stx) (parse-pat:literal stx decls)] diff --git a/collects/syntax/private/stxparse/runtime-prose.ss b/collects/syntax/private/stxparse/runtime-prose.ss index 6ed1285ee7..16338611b7 100644 --- a/collects/syntax/private/stxparse/runtime-prose.ss +++ b/collects/syntax/private/stxparse/runtime-prose.ss @@ -16,7 +16,7 @@ ;; Failure reporting parameter & default (define (default-failure-handler stx0 f) - (match f + (match (simplify-failure f) [#s(failure x frontier frontier-stx expectation) (report-failure stx0 x (last frontier) frontier-stx expectation)])) diff --git a/collects/syntax/private/stxparse/runtime.ss b/collects/syntax/private/stxparse/runtime.ss index 7d9da190d9..34aa48f88f 100644 --- a/collects/syntax/private/stxparse/runtime.ss +++ b/collects/syntax/private/stxparse/runtime.ss @@ -11,6 +11,7 @@ (provide pattern ~var + ~datum ~literal ~and ~or @@ -20,7 +21,6 @@ ~once ~optional ~rest - ~struct ~describe ~! ~bind @@ -78,6 +78,7 @@ (define-keyword pattern) (define-keyword ~var) +(define-keyword ~datum) (define-keyword ~literal) (define-keyword ~and) (define-keyword ~or) @@ -87,7 +88,6 @@ (define-keyword ~once) (define-keyword ~optional) (define-keyword ~rest) -(define-keyword ~struct) (define-keyword ~describe) (define-keyword ~!) (define-keyword ~bind) diff --git a/collects/syntax/private/stxparse/sc.ss b/collects/syntax/private/stxparse/sc.ss index 72848fe4d5..d4b3be5f39 100644 --- a/collects/syntax/private/stxparse/sc.ss +++ b/collects/syntax/private/stxparse/sc.ss @@ -25,6 +25,7 @@ pattern ~var + ~datum ~literal ~and ~or @@ -34,7 +35,6 @@ ~once ~optional ~rest - ~struct ~describe ~! ~bind diff --git a/collects/syntax/scribblings/parse-patterns.scrbl b/collects/syntax/scribblings/parse-patterns.scrbl index fd7f06c3b9..17a999542f 100644 --- a/collects/syntax/scribblings/parse-patterns.scrbl +++ b/collects/syntax/scribblings/parse-patterns.scrbl @@ -83,7 +83,7 @@ When a special form in this manual refers to @svar[syntax-pattern] (eg, the description of the @scheme[syntax-parse] special form), it means specifically @tech{@Spattern}. -@schemegrammar*[#:literals (_ ~var ~literal ~or ~and ~not ~rest ~struct +@schemegrammar*[#:literals (_ ~var ~literal ~or ~and ~not ~rest ~datum ~describe ~seq ~optional ~rep ~once ~! ~bind ~fail ~parse) [S-pattern @@ -94,6 +94,7 @@ means specifically @tech{@Spattern}. (@#,ref[~var s+] id syntax-class) (~literal literal-id) atomic-datum + (~datum datum) (H-pattern . S-pattern) (A-pattern . S-pattern) ((@#,ref[~or eh] EH-pattern ...+) #,ellipses . S-pattern) @@ -337,6 +338,33 @@ literals. ] } +@specsubform[(@#,defhere[~datum] datum)]{ + +Matches syntax whose S-expression contents (obtained by +@scheme[syntax->datum]) is @scheme[equal?] to the given +@scheme[datum]. + +@myexamples[ +(syntax-parse #'(a #:foo bar) + [(x (~datum #:foo) y) (syntax->datum #'y)]) +(syntax-parse #'(a foo bar) + [(x (~datum #:foo) y) (syntax->datum #'y)]) +] + +The @scheme[~datum] form is useful for recognizing identifiers +symbolically, in contrast to the @scheme[~literal] form, which +recognizes them by binding. + +@myexamples[ +(syntax-parse (let ([define 'something-else]) #'(define x y)) + [((~datum define) var:id e:expr) 'yes] + [_ 'no]) +(syntax-parse (let ([define 'something-else]) #'(define x y)) + [((~literal define) var:id e:expr) 'yes] + [_ 'no]) +] +} + @specsubform[(H-pattern . S-pattern)]{ Matches any term that can be decomposed into a list prefix matching diff --git a/collects/syntax/scribblings/parse.scrbl b/collects/syntax/scribblings/parse.scrbl index c7631274bc..891cc685e7 100644 --- a/collects/syntax/scribblings/parse.scrbl +++ b/collects/syntax/scribblings/parse.scrbl @@ -170,6 +170,11 @@ identifier as a binding, in which case it would get the value Here's how the syntax class would change: +@margin-note{The @scheme[(require (for-template scheme/base))] is +needed for the @scheme[quote] expression. If the syntax class +definition were a local definition in the same module, the +@scheme[for-template] would be unnecessary.} +@; @SCHEMEBLOCK[ (module example-syntax scheme/base (require syntax/parse) @@ -182,11 +187,6 @@ Here's how the syntax class would change: #:with e #'(quote #f)))) ] -@bold{Note: } The @scheme[(require (for-template scheme/base))] is -needed for the @scheme[quote] expression. If the syntax class -definition were a local definition in the same module, the -@scheme[for-template] would be unnecessary. - The second pattern matches unparenthesized identifiers. The @scheme[e] attribute is bound using a @scheme[#:with] clause, which matches the pattern @scheme[e] against the syntax from evaluating @scheme[#'#f]. @@ -321,6 +321,12 @@ failures; otherwise @scheme[stx-expr] is used. ([literal literal-id [pattern-id literal-id]])]{ +@margin-note{ + Unlike @scheme[syntax-case], @scheme[syntax-parse] requires all + literals to have a binding. To match identifiers by their symbolic + names, consider using the @scheme[~datum] pattern form instead. +} +@; The @scheme[#:literals] option specifies identifiers that should be treated as @tech{literals} rather than @tech{pattern variables}. An entry in the literals list has two components: the identifier used @@ -328,11 +334,6 @@ within the pattern to signify the positions to be matched (@scheme[pattern-id]), and the identifier expected to occur in those positions (@scheme[literal-id]). If the entry is a single identifier, that identifier is used for both purposes. - -@bold{Note:} Unlike @scheme[syntax-case], @scheme[syntax-parse] -requires all literals to have a binding. To match identifiers by their -symbolic names, consider using the @scheme[atom-in-list] syntax class -instead. } @specsubform/subs[(code:line #:literal-sets (literal-set ...))