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

syntax/parse: add ~or* and ~alt, like ~or{S,H} and ~or{EH}, respectively

Browse Source
This commit is contained in:
Ryan Culpepper 2017-06-21 18:34:36 -04:00
parent 113049607a
commit 44eb5532ad
12 changed files with 174 additions and 140 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/racket-doc/syntax/scribblings/parse/ex-kw-args.scrbl
View File

@ -19,7 +19,7 @@ match.
Optional keyword arguments are supported via @tech{head
patterns}. Unlike normal patterns, which match one term, head patterns
can match a variable number of subterms in a list. Some important
head-pattern forms are @racket[~seq], @racket[~or], and
head-pattern forms are @racket[~seq], @racket[~or*], and
@racket[~optional].
Here's one way to do it:
@ -27,7 +27,7 @@ Here's one way to do it:
@interaction[#:eval the-eval
(define-syntax (mycond stx)
(syntax-parse stx
[(mycond (~or (~seq #:error-on-fallthrough who:expr) (~seq))
[(mycond (~or* (~seq #:error-on-fallthrough who:expr) (~seq))
clause ...)
(with-syntax ([error? (if (attribute who) #'#t #'#f)]
[who (or (attribute who) #'#f)])
@ -57,7 +57,7 @@ attribute.
[(odd? 4) 'red])
]
There's a simpler way of writing the @racket[~or] pattern above:
There's a simpler way of writing the @racket[~or*] pattern above:
@racketblock[
(~optional (~seq #:error-on-fallthrough who:expr))
]

92
pkgs/racket-doc/syntax/scribblings/parse/ex-many-kws.scrbl
View File

@ -36,18 +36,18 @@ Given those auxiliary syntax classes, here is a first approximation of
the main pattern, including the struct options:
@racketblock[
(struct name:id super:maybe-super (field:field ...)
(~or (~seq #:mutable)
(~seq #:super super-expr:expr)
(~seq #:inspector inspector:expr)
(~seq #:auto-value auto:expr)
(~seq #:guard guard:expr)
(~seq #:property prop:expr prop-val:expr)
(~seq #:transparent)
(~seq #:prefab)
(~seq #:constructor-name constructor-name:id)
(~seq #:extra-constructor-name extra-constructor-name:id)
(~seq #:omit-define-syntaxes)
(~seq #:omit-define-values))
(~alt (~seq #:mutable)
(~seq #:super super-expr:expr)
(~seq #:inspector inspector:expr)
(~seq #:auto-value auto:expr)
(~seq #:guard guard:expr)
(~seq #:property prop:expr prop-val:expr)
(~seq #:transparent)
(~seq #:prefab)
(~seq #:constructor-name constructor-name:id)
(~seq #:extra-constructor-name extra-constructor-name:id)
(~seq #:omit-define-syntaxes)
(~seq #:omit-define-values))
...)
]
The fact that @racket[expr] does not match keywords helps in the case
@ -71,20 +71,20 @@ a pattern variable to the keyword itself, as in this sub-pattern:
The second problem can be solved using @emph{repetition constraints}:
@racketblock[
(struct name:id super:maybe-super (field:field ...)
(~or (~optional (~seq (~and #:mutable mutable-kw)))
(~optional (~seq #:super super-expr:expr))
(~optional (~seq #:inspector inspector:expr))
(~optional (~seq #:auto-value auto:expr))
(~optional (~seq #:guard guard:expr))
(~seq #:property prop:expr prop-val:expr)
(~optional (~seq (~and #:transparent transparent-kw)))
(~optional (~seq (~and #:prefab prefab-kw)))
(~optional (~seq #:constructor-name constructor-name:id))
(~optional
(~alt (~optional (~seq (~and #:mutable mutable-kw)))
(~optional (~seq #:super super-expr:expr))
(~optional (~seq #:inspector inspector:expr))
(~optional (~seq #:auto-value auto:expr))
(~optional (~seq #:guard guard:expr))
(~seq #:property prop:expr prop-val:expr)
(~optional (~seq (~and #:transparent transparent-kw)))
(~optional (~seq (~and #:prefab prefab-kw)))
(~optional (~seq #:constructor-name constructor-name:id))
(~optional
(~seq #:extra-constructor-name extra-constructor-name:id))
(~optional
(~optional
(~seq (~and #:omit-define-syntaxes omit-def-stxs-kw)))
(~optional (~seq (~and #:omit-define-values omit-def-vals-kw))))
(~optional (~seq (~and #:omit-define-values omit-def-vals-kw))))
...)
]
The @racket[~optional] repetition constraint indicates that an
@ -101,29 +101,29 @@ mutually exclusive, such as @racket[#:inspector],
@racketblock[
(struct name:id super:maybe-super (field:field ...)
(~or (~optional
(~or (~seq #:inspector inspector:expr)
(~seq (~and #:transparent transparent-kw))
(~seq (~and #:prefab prefab-kw)))
(~alt (~optional
(~or* (~seq #:inspector inspector:expr)
(~seq (~and #:transparent transparent-kw))
(~seq (~and #:prefab prefab-kw)))
#:name "#:inspector, #:transparent, or #:prefab option")
(~optional (~seq (~and #:mutable mutable-kw))
#:name "#:mutable option")
(~optional (~seq #:super super-expr:expr)
#:name "#:super option")
(~optional (~seq #:auto-value auto:expr)
#:name "#:auto-value option")
(~optional (~seq #:guard guard:expr)
#:name "#:guard option")
(~seq #:property prop:expr prop-val:expr)
(~optional (~seq #:constructor-name constructor-name:id)
#:name "#:constructor-name option")
(~optional
(~seq #:extra-constructor-name extra-constructor-name:id)
#:name "#:extra-constructor-name option")
(~optional (~seq (~and #:omit-define-syntaxes omit-def-stxs-kw))
#:name "#:omit-define-syntaxes option")
(~optional (~seq (~and #:omit-define-values omit-def-vals-kw))
#:name "#:omit-define-values option"))
(~optional (~seq (~and #:mutable mutable-kw))
#:name "#:mutable option")
(~optional (~seq #:super super-expr:expr)
#:name "#:super option")
(~optional (~seq #:auto-value auto:expr)
#:name "#:auto-value option")
(~optional (~seq #:guard guard:expr)
#:name "#:guard option")
(~seq #:property prop:expr prop-val:expr)
(~optional (~seq #:constructor-name constructor-name:id)
#:name "#:constructor-name option")
(~optional
(~seq #:extra-constructor-name extra-constructor-name:id)
#:name "#:extra-constructor-name option")
(~optional (~seq (~and #:omit-define-syntaxes omit-def-stxs-kw))
#:name "#:omit-define-syntaxes option")
(~optional (~seq (~and #:omit-define-values omit-def-vals-kw))
#:name "#:omit-define-values option"))
...)
]
Here we have grouped the three incompatible options together under a

12
pkgs/racket-doc/syntax/scribblings/parse/experimental.scrbl
View File

@ -139,7 +139,7 @@ Like @racket[~reflect] but for reified splicing syntax classes.
(define (partition/r stx r n)
(syntax-parse stx
[((~or (~reflect yes (r n)) no) ...)
[((~alt (~reflect yes (r n)) no) ...)
#'((yes ...) (no ...))]))
(partition/r #'(1 2 3 4 5) r-nat> 3)
@ -201,8 +201,8 @@ reusable encapsulations of @|EHpatterns|.
Defines @racket[name] as an ellipsis-head alternative set. Using
@racket[name] (via @racket[~eh-var]) in an ellipsis-head pattern is
equivalent to including each of the alternatives in the pattern via
@ref[~or eh], except that the attributes bound by the alternatives are
prefixed with the name given to @racket[~eh-var].
@racket[~alt], except that the attributes bound by the alternatives
are prefixed with the name given to @racket[~eh-var].
Unlike syntax classes, ellipsis-head alternative sets must be defined
before they are referenced.
@ -231,8 +231,8 @@ their attributes with @racket[name].
(define (parse/more-options stx)
(syntax-parse stx
[(_ (~or (~eh-var s options)
(~seq #:c c1:expr c2:expr))
[(_ (~alt (~eh-var s options)
(~seq #:c c1:expr c2:expr))
...)
#'(s.a (s.b ...) ((c1 c2) ...))]))
(parse/more-options #'(m #:a 1 #:b 2 #:c 3 4 #:c 5 6))
@ -361,7 +361,7 @@ template. Can only occur in head position in a template.
@examples[#:eval the-eval
(syntax-parse #'(m #:a 1 #:b 2 3 4 #:e 5)
[(_ (~or pos:expr (~seq kw:keyword kwarg:expr)) ...)
[(_ (~alt pos:expr (~seq kw:keyword kwarg:expr)) ...)
(template (m2 (?@ kw kwarg) ... pos ...))])
]

62
pkgs/racket-doc/syntax/scribblings/parse/patterns.scrbl
View File

@ -32,7 +32,7 @@ When a special form in this manual refers to @svar[syntax-pattern]
(eg, the description of the @racket[syntax-parse] special form), it
means specifically @tech{@Spattern}.
@racketgrammar*[#:literals (_ ~var ~literal ~or ~and ~not ~rest ~datum
@racketgrammar*[#:literals (_ ~var ~literal ~or ~alt ~or* ~and ~not ~rest ~datum
~describe ~seq ~optional ~rep ~once ~between
~! ~bind ~fail ~parse ~peek ~peek-not ~do ~post)
[S-pattern
@ -51,7 +51,7 @@ means specifically @tech{@Spattern}.
(EH-pattern #,ellipses . S-pattern)
(H-pattern @#,dotsplus . S-pattern)
(@#,ref[~and s] proper-S/A-pattern ...+)
(@#,ref[~or s] S-pattern ...+)
(@#,ref[~or* s] S-pattern ...+)
(~not S-pattern)
#((unsyntax @svar[pattern-part]) ...)
#s(prefab-struct-key (unsyntax @svar[pattern-part]) ...)
@ -76,7 +76,7 @@ means specifically @tech{@Spattern}.
maybe-role)
(~seq . L-pattern)
(@#,ref[~and h] proper-H/A-pattern ...+)
(@#,ref[~or h] H-pattern ...+)
(@#,ref[~or* h] H-pattern ...+)
(@#,ref[~optional h] H-pattern maybe-optional-option)
(@#,ref[~describe h] maybe-opaque maybe-role expr H-pattern)
(@#,ref[~commit h] H-pattern)
@ -86,7 +86,7 @@ means specifically @tech{@Spattern}.
(~peek-not H-pattern)
proper-S-pattern]
[EH-pattern
(@#,ref[~or eh] EH-pattern ...)
(~alt EH-pattern ...)
(~once H-pattern once-option ...)
(@#,ref[~optional eh] H-pattern optional-option ...)
(~between H min-number max-number between-option)
@ -123,15 +123,28 @@ One of @ref[~and s], @ref[~and h], or @ref[~and a]:
]
}
@defidform[~or*]{
One of @ref[~or* s] or @ref[~or* h]:
@itemize[
@item{@ref[~or* h] if any of the disjuncts is a @tech{proper @Hpattern}}
@item{@ref[~or* s] otherwise}
]
}
@defidform[~or]{
One of @ref[~or s], @ref[~or h], or @ref[~or eh]:
Behaves like @ref[~or* s], @ref[~or* h], or @racket[~alt]:
@itemize[
@item{@ref[~or eh] if the pattern occurs directly before ellipses
(@ellipses) or immediately within another @ref[~or eh] pattern}
@item{@ref[~or h] if any of the disjuncts is a @tech{proper @Hpattern}}
@item{@ref[~or s] otherwise}
@item{like @racket[~alt] if the pattern occurs directly before ellipses
(@ellipses) or immediately within another @racket[~alt] pattern}
@item{like @ref[~or* h] if any of the disjuncts is a @tech{proper @Hpattern}}
@item{like @ref[~or* s] otherwise}
]
The context-sensitive interpretation of @racket[~or] is a design
mistake and a common source of confusion. Use @racket[~alt] and
@racket[~or*] instead.
}
@defidform[~describe]{
@ -175,8 +188,7 @@ One of @ref[~post s], @ref[~post h], or @ref[~post a]:
One of @ref[~optional h] or @ref[~optional eh]:
@itemize[
@item{@ref[~optional eh] if it is an immediate disjunct of a @ref[~or
eh] pattern}
@item{@ref[~optional eh] if it is an immediate disjunct of an @racket[~alt] pattern}
@item{@ref[~optional h] otherwise}
]
}
@ -494,7 +506,7 @@ purpose, but @racket[~and] can be lighter weight.
]
}
@specsubform[(@#,def[~or s] S-pattern ...)]{
@specsubform[(@#,def[~or* s] S-pattern ...)]{
Matches any term that matches one of the included patterns. The
alternatives are tried in order.
@ -507,11 +519,11 @@ to have a value if the whole pattern matches.
@examples[#:eval the-eval
(syntax-parse #'a
[(~or x:id y:nat) (values (attribute x) (attribute y))])
[(~or* x:id y:nat) (values (attribute x) (attribute y))])
(syntax-parse #'(a 1)
[(~or (x:id y:nat) (x:id)) (values #'x (attribute y))])
[(~or* (x:id y:nat) (x:id)) (values #'x (attribute y))])
(syntax-parse #'(b)
[(~or (x:id y:nat) (x:id)) (values #'x (attribute y))])
[(~or* (x:id y:nat) (x:id)) (values #'x (attribute y))])
]
}
@ -746,17 +758,17 @@ example with the second @racket[~seq] omitted:
]
}
@specsubform[(@#,def[~or h] H-pattern ...)]{
@specsubform[(@#,def[~or* h] H-pattern ...)]{
Like the @Spattern version, @ref[~or s], but matches a sequence of
Like the @Spattern version, @ref[~or* s], but matches a sequence of
terms instead.
@examples[#:eval the-eval
(syntax-parse #'(m #:foo 2 a b c)
[(_ (~or (~seq #:foo x) (~seq)) y:id ...)
[(_ (~or* (~seq #:foo x) (~seq)) y:id ...)
(attribute x)])
(syntax-parse #'(m a b c)
[(_ (~or (~seq #:foo x) (~seq)) y:id ...)
[(_ (~or* (~seq #:foo x) (~seq)) y:id ...)
(attribute x)])
]
}
@ -846,7 +858,7 @@ outside of the @racket[~peek-not]-pattern.
(pattern (~seq x (~peek-not _))))
(syntax-parse #'(a b c)
[((~or f:final other) ...)
[((~alt f:final other) ...)
(printf "finals are ~s\n" (syntax->datum #'(f.x ...)))
(printf "others are ~s\n" (syntax->datum #'(other ...)))])
]
@ -868,14 +880,14 @@ that describes some number of terms, like a @tech{@Hpattern}, but also
places constraints on the number of times it occurs in a
repetition. They are useful for matching, for example, keyword
arguments where the keywords may come in any order. Multiple
alternatives are grouped together via @ref[~or eh].
alternatives are grouped together via @racket[~alt].
@examples[#:eval the-eval
(define parser1
(syntax-parser
[((~or (~once (~seq #:a x) #:name "#:a keyword")
(~optional (~seq #:b y) #:name "#:b keyword")
(~seq #:c z)) ...)
[((~alt (~once (~seq #:a x) #:name "#:a keyword")
(~optional (~seq #:b y) #:name "#:b keyword")
(~seq #:c z)) ...)
'ok]))
(parser1 #'(#:a 1))
(parser1 #'(#:b 2 #:c 3 #:c 25 #:a 'hi))
@ -889,7 +901,7 @@ arguments. The ``pieces'' can occur in any order.
Here are the variants of @elem{@EHpattern}:
@specsubform[(@#,def[~or eh] EH-pattern ...)]{
@specsubform[(@#,defhere[~alt] EH-pattern ...)]{
Matches if any of the inner @racket[EH-pattern] alternatives match.
}

4
pkgs/racket-doc/syntax/scribblings/parse/stxclasses.scrbl
View File

@ -456,14 +456,14 @@ binds the following nested attributes: @racket[y.a] at depth 2,
depth 1.
An attribute's ellipsis nesting depth is @emph{not} a guarantee that
it is syntax-valued. In particular, @racket[~or] and
it is syntax-valued. In particular, @racket[~or*] and
@racket[~optional] patterns may result in attributes with fewer than
expected levels of list nesting, and @racket[#:attr] and
@racket[~bind] can be used to bind attributes to arbitrary values.
@examples[#:eval the-eval
(syntax-parse #'(a b 3)
[(~or (x:id ...) _)
[(~or* (x:id ...) _)
(attribute x)])
]

32
pkgs/racket-test/tests/stxparse/stxclass.rkt
View File

@ -113,28 +113,28 @@
(check-equal? (syntax->datum #'(t.a ...)) '(1 4 6)))
(test-patterns (t:two-to-four/untagged ...) #'((1 2 3) (4 5) (6 7 8))
(check-equal? (syntax->datum #'(t.b ...)) '(2 5 7)))
(test-patterns ({~or {~seq x:id v:nat} s:str} ...) #'(x 1 y 2 "whee" x 3)
(test-patterns ({~alt {~seq x:id v:nat} s:str} ...) #'(x 1 y 2 "whee" x 3)
(check-equal? (stx->datum #'((x v) ...)) '((x 1) (y 2) (x 3)))
(check-equal? (stx->datum #'(s ...)) '("whee")))
(test-patterns ({~or {~seq x:id v:nat} s:str} ...) #'(x 1 y 2 "whee" x 3)
(test-patterns ({~alt {~seq x:id v:nat} s:str} ...) #'(x 1 y 2 "whee" x 3)
(check-equal? (stx->datum #'((x v) ...)) '((x 1) (y 2) (x 3)))
(check-equal? (stx->datum #'(s ...)) '("whee")))
(test-patterns ({~or (~once 1)
(~once 2)
(~once 3)} ...)
(test-patterns ({~alt (~once 1)
(~once 2)
(~once 3)} ...)
#'(1 2 3)
(void))
(test-patterns ({~or a:id b:nat c:str} ...) #'("one" 2 three)
(test-patterns ({~alt a:id b:nat c:str} ...) #'("one" 2 three)
(check-equal? (stx->datum #'(a ...)) '(three))
(check-equal? (stx->datum #'(b ...)) '(2))
(check-equal? (stx->datum #'(c ...)) '("one"))
(void))
(test-patterns ({~or (~once 1)
(~once 2)
(~once 3)
(~once x)
(~once y)
(~once w)} ...)
(test-patterns ({~alt (~once 1)
(~once 2)
(~once 3)
(~once x)
(~once y)
(~once w)} ...)
#'(1 2 3 x y z)
(for ([s (syntax->list #'(x y w))]) (check-pred identifier? s))
(check-equal? (sort
@ -142,10 +142,10 @@
string<?)
'("x" "y" "z"))
(void))
(test-patterns ({~or x
(~once 1)
(~once 2)
(~once 3)} ...)
(test-patterns ({~alt x
(~once 1)
(~once 2)
(~once 3)} ...)
#'(1 2 3 x y z)
(check-equal? (stx->datum #'(x ...)) '(x y z))
(void))

12
pkgs/racket-test/tests/stxparse/test-errors.rkt
View File

@ -127,6 +127,18 @@
#rx"^syntax-parse: "
#rx"head pattern not allowed here")
(tcerr "parse-pat:dots: alt, not list"
(syntax-parser
[((~alt . x) ...) 'ok])
#rx"^syntax-parser: "
#rx"expected sequence of patterns")
(tcerr "parse-pat:dots: alt, empty"
(syntax-parser
[((~alt) ...) 'ok])
#rx"^syntax-parser: "
#rx"expected at least one pattern")
(tcerr "parse-pat:dots: or, not list"
(syntax-parser
[((~or . x) ...) 'ok])

4
pkgs/racket-test/tests/stxparse/test-exp.rkt
View File

@ -22,7 +22,7 @@
(define r-nat> (reify-syntax-class nat>))
(tok (1 2 -3 -4 5) ((~or (~reflect yes (r-nat> 1) #:attributes (diff)) no) ...)
(tok (1 2 -3 -4 5) ((~alt (~reflect yes (r-nat> 1) #:attributes (diff)) no) ...)
(and (s= (yes ...) '(2 5))
(s= (yes.diff ...) '(1 4))
(s= (no ...) '(1 -3 -4))))
@ -32,7 +32,7 @@
(define r-nat>1 (reified-syntax-class-curry r-nat> 1))
(tok (1 2 -3 -4 5) ((~or (~reflect yes (r-nat>1) #:attributes (diff)) no) ...)
(tok (1 2 -3 -4 5) ((~alt (~reflect yes (r-nat>1) #:attributes (diff)) no) ...)
(and (s= (yes ...) '(2 5))
(s= (yes.diff ...) '(1 4))
(s= (no ...) '(1 -3 -4))))

6
pkgs/racket-test/tests/stxparse/test-template.rkt
View File

@ -32,8 +32,8 @@
(define/with-syntax (nn ...) #'(1 2 3))
(define/with-syntax ((yy ...) ...) #'((1 2 3) (4 5 6) (7 8 9)))
(define/syntax-parse (~or oo:nat _:id) #'x)
(define/syntax-parse ((~describe "x" (~or pp:nat _:id)) ...) #'(a 1 b 2 3))
(define/syntax-parse (~or* oo:nat _:id) #'x)
(define/syntax-parse ((~or* pp:nat _:id) ...) #'(a 1 b 2 3))
;; ----------------------------------------
@ -333,7 +333,7 @@
(template (?? '(a (?? b 0)) 0))])
''(a 0))
(define/syntax-parse ((~and (~or i:id n:nat)) ...) '(a b 1 2 3 4))
(define/syntax-parse ((~or* i:id n:nat) ...) '(a b 1 2 3 4))
;; note: i,n both 6 elts long
(tc (template ((?? i X) ...))

54
pkgs/racket-test/tests/stxparse/test.rkt
View File

@ -202,20 +202,20 @@
;; and scoping
(tok 1 (~and a (~fail #:unless (equal? (syntax->datum #'a) 1))))
;; or patterns
(tok 1 (~or 1 2 3)
;; or* patterns
(tok 1 (~or* 1 2 3)
'ok)
(tok 3 (~or 1 2 3)
(tok 3 (~or* 1 2 3)
'ok)
(tok (1) (~or (a) (a b) (a b c))
(tok (1) (~or* (a) (a b) (a b c))
(and (bound (a 0 #t) (b 0 #f) (c 0 #f)) (s= a 1) (a= b #f) (a= c #f)))
(tok (1 2 3) (~or (a) (a b) (a b c))
(tok (1 2 3) (~or* (a) (a b) (a b c))
(and (bound (a 0 #t) (b 0 #f) (c 0 #f)) (s= a 1) (s= b 2) (s= c 3)))
(tok 1 (~or 5 _)
(tok 1 (~or* 5 _)
'ok)
(tok #t (~or #t #f)
(tok #t (~or* #t #f)
'ok)
(tok #t (~or (~and #t x) (~and #f x))
(tok #t (~or* (~and #t x) (~and #f x))
(and (bound (x 0 #t))))
;; describe
@ -236,7 +236,7 @@
(and (bound (x 0) (x.a 0) (a 0)) (s= x '(1 2)) (s= x.a 1) (s= a 1)))
;; delimit-cut
(tok (1 (2 3)) (1 (~or (~delimit-cut (2 ~! 4)) (2 3))))
(tok (1 (2 3)) (1 (~or* (~delimit-cut (2 ~! 4)) (2 3))))
(tok (1 2 3) (1 2 3)
'ok
#:pre [(~delimit-cut (1 2 ~! 4))] #:post [])
@ -248,7 +248,7 @@
(tok (define-values (a b c) 1) d:def
'ok)
(terx (define-values (a 2) 3) (~or d:def e:expr)
(terx (define-values (a 2) 3) (~or* d:def e:expr)
#rx"expected identifier")
(terx* (define-values (a 2) 3) [d:def e:expr]
#rx"expected identifier")
@ -256,10 +256,10 @@
;; commit
(define-syntax-class xyseq
#:commit
(pattern ((~or x y) ...)))
(pattern ((~alt x y) ...)))
(tok (1 2 3 4 5 6 7 8)
(~and ((~or s.x s.y) ...)
(~and ((~alt s.x s.y) ...)
(~fail #:unless (= (apply + (syntax->datum #'(s.x ...)))
(apply + (syntax->datum #'(s.y ...))))
"nope"))
@ -271,7 +271,7 @@
"nope"))
#rx"nope")
(terx (1 2 3 4 5 6 7 8)
(~and (~commit ((~or s.x s.y) ...))
(~and (~commit ((~alt s.x s.y) ...))
(~fail #:unless (= (apply + (syntax->datum #'(s.x ...)))
(apply + (syntax->datum #'(s.y ...))))
"nope"))
@ -284,12 +284,12 @@
(tok (1 2 3) (1 (~seq 2) 3))
(tok (1 2 3) ((~seq) 1 2 3))
;; or
(tok (1 2 3) ((~or (~seq 1 2) 1) 3))
(tok (1 2 3) ((~or 1 (~seq 1 2)) 3))
(tok (1 2 3) ((~or (~seq 1) (~seq 1 2)) 3))
(tok (1 2 3) ((~or (~seq 1) (~seq)) 1 2 3))
(tok (1 2 3) ((~or (~seq 1) (~seq)) 1 2 3 (~or (~seq 4) (~seq))))
;; or*
(tok (1 2 3) ((~or* (~seq 1 2) 1) 3))
(tok (1 2 3) ((~or* 1 (~seq 1 2)) 3))
(tok (1 2 3) ((~or* (~seq 1) (~seq 1 2)) 3))
(tok (1 2 3) ((~or* (~seq 1) (~seq)) 1 2 3))
(tok (1 2 3) ((~or* (~seq 1) (~seq)) 1 2 3 (~or (~seq 4) (~seq))))
;; describe
(tok (1 2 3) ((~describe "one-two" (~seq 1 2)) 3))
@ -314,7 +314,7 @@
;; bind patterns
(tok 1 (~and x (~bind [y #'x]))
(s= y '1))
(tok 1 (~or x:id (~bind [x #'default]))
(tok 1 (~or* x:id (~bind [x #'default]))
(s= x 'default))
;; fail patterns
@ -330,7 +330,7 @@
(terx 1 (~fail "grr")
#rx"grr")
(tok (1 2 3) (x:nat y:nat (~parse (~or 2 3) (+ (syntax-e #'x) (syntax-e #'y))) z:nat))
(tok (1 2 3) (x:nat y:nat (~parse (~or* 2 3) (+ (syntax-e #'x) (syntax-e #'y))) z:nat))
(terx (1 2 3) (x:nat y:nat (~parse 4 (+ (syntax-e #'x) (syntax-e #'y))) z:nat)
"expected the literal 4")
(terx (1 2 3) (x:nat y:nat (~parse (2 4) #'(x y)))
@ -667,8 +667,8 @@
(syntax-case stx ()
[(separated sep pat)
(with-syntax ([ooo '...])
#'((~seq pat (~or (~peek-not _)
(~seq sep (~peek _))))
#'((~seq pat (~or* (~peek-not _)
(~seq sep (~peek _))))
ooo))]))))
(define-splicing-syntax-class bindings
@ -694,8 +694,8 @@
(syntax-case stx ()
[(sep-comma pat)
(with-syntax ([ooo '...])
#'((~seq (~or (~and pat (~not ((~datum unquote) _))) ((~datum unquote) pat))
(~or (~peek-not _) (~peek ((~datum unquote) _))))
#'((~seq (~or* (~and pat (~not ((~datum unquote) _))) ((~datum unquote) pat))
(~or* (~peek-not _) (~peek ((~datum unquote) _))))
ooo))]))))
(define-splicing-syntax-class bindings2
@ -727,7 +727,7 @@
#'(~once (~seq (~and kw name) pat ...)
#:name (format "the ~a keyword" 'kw)))]))))
(check-equal? (syntax-parse #'(m #:a #:b 1 #:a)
[(_ (~or #:a (~oncekw #:b b)) ...)
[(_ (~alt #:a (~oncekw #:b b)) ...)
(syntax->datum #'(b-kw b))])
'(#:b 1)))
@ -780,7 +780,7 @@
;; nullable but bounded EH pattern ok (thanks Alex Knauth) (7/2016)
(tok (1 2 3) ((~once (~seq)) ... n:nat ...) 'ok)
(tok (1 2 3) ((~once (~or (~seq a:id) (~seq))) ... x y z) 'ok)
(tok (1 2 3) ((~once (~or* (~seq a:id) (~seq))) ... x y z) 'ok)
(struct s-3d () #:transparent)
(test-case "3D syntax checks"

3
racket/collects/syntax/parse/private/keywords.rkt
View File

@ -38,3 +38,6 @@
(define-keyword ~eh-var)
(define-keyword ~peek)
(define-keyword ~peek-not)
(define-keyword ~or*)
(define-keyword ~alt)

27
racket/collects/syntax/parse/private/rep.rkt
View File

@ -106,6 +106,8 @@
(quote-syntax ~literal)
(quote-syntax ~and)
(quote-syntax ~or)
(quote-syntax ~or*)
(quote-syntax ~alt)
(quote-syntax ~not)
(quote-syntax ~seq)
(quote-syntax ~rep)
@ -456,7 +458,7 @@
(wrong-syntax stx "action pattern not allowed here")]))
(define not-shadowed? (make-not-shadowed? decls))
(check-pattern
(syntax-case* stx (~var ~literal ~datum ~and ~or ~not ~rest ~describe
(syntax-case* stx (~var ~literal ~datum ~and ~or ~or* ~alt ~not ~rest ~describe
~seq ~optional ~! ~bind ~fail ~parse ~do
~post ~peek ~peek-not ~delimit-cut ~commit ~reflect
~splicing-reflect)
@ -514,6 +516,11 @@
[(~or . rest)
(disappeared! stx)
(parse-pat:or stx decls allow-head?)]
[(~or* . rest)
(disappeared! stx)
(parse-pat:or stx decls allow-head?)]
[(~alt . rest)
(wrong-syntax stx "ellipsis-head pattern allowed only before ellipsis")]
[(~not . rest)
(disappeared! stx)
(parse-pat:not stx decls)]
@ -622,8 +629,11 @@
(define (parse*-ellipsis-head-pattern stx decls allow-or?
#:context [ctx (current-syntax-context)])
(define (recur stx) (parse*-ellipsis-head-pattern stx decls allow-or? #:context ctx))
(define (recur-cdr-list stx)
(unless (stx-list? stx) (wrong-syntax stx "expected sequence of patterns"))
(apply append (map recur (cdr (stx->list stx)))))
(define not-shadowed? (make-not-shadowed? decls))
(syntax-case* stx (~eh-var ~or ~between ~optional ~once)
(syntax-case* stx (~eh-var ~or ~alt ~between ~optional ~once)
(make-not-shadowed-id=? decls)
[id
(and (identifier? #'id)
@ -653,14 +663,11 @@
(replace-eh-alternative-attrs
alt (iattrs->sattrs iattrs))))))]
[(~or . _)
allow-or?
(begin
(disappeared! stx)
(unless (stx-list? stx)
(wrong-syntax stx "expected sequence of patterns"))
(apply append
(for/list ([sub (in-list (cdr (stx->list stx)))])
(parse*-ellipsis-head-pattern sub decls allow-or?))))]
(disappeared! stx)
(recur-cdr-list stx)]
[(~alt . _)
(disappeared! stx)
(recur-cdr-list stx)]
[(~optional . _)
(disappeared! stx)
(list (parse*-ehpat/optional stx decls))]