syntax/parse:

fixed bug in error selection
  added ~datum patterns

svn: r16497

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)))]))

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

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)]

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)]))
 

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)

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

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

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 ...))