syntax/parse:
fixed bug: splicing-stxclass immediately within ellipses added tests, docs for local-conventions svn: r17944
This commit is contained in:
parent
319a4a7ef0
commit
8d2f32efed
|
@ -369,6 +369,7 @@
|
|||
#'#s(pat:compound attrs #:pair (head-part tail-part)))])))
|
||||
|
||||
;; (parse:H id FCE HeadPattern id id expr) : expr
|
||||
;; x must not alias rest
|
||||
(define-syntax (parse:H stx)
|
||||
(syntax-case stx ()
|
||||
[(parse:H x fc head rest rest-fc k)
|
||||
|
@ -471,11 +472,11 @@
|
|||
[(attr-repc ...) attr-repcs])
|
||||
(define-pattern-variable alt-map #'((id . alt-id) ...))
|
||||
(define-pattern-variable loop-k
|
||||
#'(dots-loop dx loop-fc* enclosing-fail rel-rep ... alt-id ...))
|
||||
#'(dots-loop dx* loop-fc* enclosing-fail rel-rep ... alt-id ...))
|
||||
#`(let ()
|
||||
(define (dots-loop dx loop-fc loop-fail rel-rep ... alt-id ...)
|
||||
(with-enclosing-fail loop-fail
|
||||
(try (parse:EH dx loop-fc head head-repc loop-fc* alt-map head-rep
|
||||
(try (parse:EH dx loop-fc head head-repc dx* loop-fc* alt-map head-rep
|
||||
loop-k)
|
||||
...
|
||||
(cond [(< rel-rep (rep:min-number rel-repc))
|
||||
|
@ -494,7 +495,7 @@
|
|||
;; RepConstraint/#f expr) : expr
|
||||
(define-syntax (parse:EH stx)
|
||||
(syntax-case stx ()
|
||||
[(parse:EH x fc head repc fc* alts rep k0)
|
||||
[(parse:EH x fc head repc x* fc* alts rep k0)
|
||||
(let ()
|
||||
(define-pattern-variable k
|
||||
(let* ([main-attrs (wash-iattrs (pattern-attrs (wash #'head)))]
|
||||
|
@ -511,11 +512,11 @@
|
|||
#`(let ([alt-id (rep:combine repc (attribute id) alt-id)] ...)
|
||||
k0))))
|
||||
(syntax-case #'repc ()
|
||||
[#f #`(parse:H x fc head x fc* k)]
|
||||
[_ #`(parse:H x fc head x fc*
|
||||
[#f #`(parse:H x fc head x* fc* k)]
|
||||
[_ #`(parse:H x fc head x* fc*
|
||||
(if (< rep (rep:max-number repc))
|
||||
(let ([rep (add1 rep)]) k)
|
||||
(fail x
|
||||
(fail x*
|
||||
#:expect (expectation-of-reps/too-many rep repc)
|
||||
#:fce fc*)))]))]))
|
||||
|
||||
|
|
|
@ -357,7 +357,8 @@ variables that do not explicitly specify a syntax class.
|
|||
|
||||
Uses the @tech{conventions} specified. The advantage of
|
||||
@scheme[#:local-conventions] over @scheme[#:conventions] is that local
|
||||
conventions can be in the scope of syntax-class parameter bindings.
|
||||
conventions can be in the scope of syntax-class parameter
|
||||
bindings. See the section on @tech{conventions} for examples.
|
||||
}
|
||||
|
||||
Each clause consists of a @tech{syntax pattern}, an optional sequence
|
||||
|
@ -751,6 +752,28 @@ class.
|
|||
(syntax->datum #'(x0 (x ...) n0 (n ...)))])
|
||||
]
|
||||
|
||||
Local conventions, introduced with the @scheme[#:local-conventions]
|
||||
keyword argument of @scheme[syntax-parse] and syntax class
|
||||
definitions, may refer to local bindings:
|
||||
|
||||
@myexamples[
|
||||
(define-syntax-class (nat> bound)
|
||||
(pattern n:nat
|
||||
#:fail-unless (> (syntax-e #'n) bound)
|
||||
(format "expected number > ~s" bound)))
|
||||
|
||||
(define-syntax-class (natlist> bound)
|
||||
#:local-conventions ([N (nat> bound)])
|
||||
(pattern (N ...)))
|
||||
|
||||
(define (parse-natlist> bound x)
|
||||
(syntax-parse x
|
||||
#:local-conventions ([NS (natlist> bound)])
|
||||
[NS 'ok]))
|
||||
(parse-natlist> 0 #'(1 2 3))
|
||||
(parse-natlist> 5 #'(8 6 4 2))
|
||||
]
|
||||
|
||||
}
|
||||
|
||||
@;{----------}
|
||||
|
|
|
@ -189,19 +189,19 @@
|
|||
|
||||
(tcerr "parse-ehpat/bounds: min"
|
||||
(syntax-parser
|
||||
[((~bounds x 1.0 9) ...) 'ok])
|
||||
[((~between x 1.0 9) ...) 'ok])
|
||||
#rx"^syntax-parser: "
|
||||
#rx"expected exact nonnegative integer")
|
||||
|
||||
(tcerr "parse-ehpat/bounds: max"
|
||||
(syntax-parser
|
||||
[((~bounds x 1 "foo") ...) 'ok])
|
||||
[((~between x 1 "foo") ...) 'ok])
|
||||
#rx"^syntax-parser: "
|
||||
#rx"expected exact nonnegative integer")
|
||||
|
||||
(tcerr "parse-ehpat/bounds: min>max"
|
||||
(syntax-parser
|
||||
[((~bounds x 3 2) ...) 'ok])
|
||||
[((~between x 3 2) ...) 'ok])
|
||||
#rx"^syntax-parser: "
|
||||
#rx"minimum larger than maximum")
|
||||
|
||||
|
|
|
@ -210,3 +210,26 @@
|
|||
(syntax-parse #'(4 -1) #:conventions (nat-convs)
|
||||
[(N ...) (void)]))
|
||||
(error 'test-conv1 "didn't work"))
|
||||
|
||||
;; Local conventions
|
||||
|
||||
(define-syntax-class (nats> bound)
|
||||
#:local-conventions ([N (nat> bound)])
|
||||
(pattern (N ...)))
|
||||
|
||||
(define (p1 bound x)
|
||||
(syntax-parse x
|
||||
#:local-conventions ([ns (nats> bound)])
|
||||
[ns 'yes]
|
||||
[_ 'no]))
|
||||
|
||||
(eq? (p1 0 #'(1 2 3)) 'yes)
|
||||
(eq? (p1 2 #'(1 2 3)) 'no)
|
||||
|
||||
;; Regression (2/2/2010)
|
||||
|
||||
(define-splicing-syntax-class twoseq
|
||||
(pattern (~seq a b)))
|
||||
|
||||
(syntax-parse #'(1 2 3 4)
|
||||
[(x:twoseq ...) 'ok])
|
||||
|
|
Loading…
Reference in New Issue
Block a user