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

syntax/parse: fix bug: integrated stxclass might not bind pvar to syntax

Browse Source
This commit is contained in:
Ryan Culpepper 2011-09-21 16:40:57 -06:00
parent 81e0f3f3d7
commit 7cc1476170
4 changed files with 20 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/redex/private/reduction-semantics.rkt
View File

@ -1603,7 +1603,8 @@
(syntax-parse body #:context full-stx
[((~or (~seq #:mode ~! mode:mode-spec)
(~seq #:contract ~! contract:contract-spec))
... . rules:expr)
...
rule:expr ...)
(let-values ([(name/mode mode)
(syntax-parse #'(mode ...)
[((name . mode)) (values #'name (syntax->list #'mode))]
@ -1618,7 +1619,8 @@
(raise-syntax-error
syn-err-name "expected at most one contract specification"
#f #f (syntax->list #'dups))])])
(values name/mode mode name/ctc ctc (parse-rules #'rules)))]))
(values name/mode mode name/ctc ctc
(parse-rules (syntax->list #'(rule ...)))))]))
(check-clauses full-stx syn-err-name rules #t)
(check-arity-consistency mode contract full-stx)
(define-values (form-name dup-names)

4
collects/syntax/parse/private/lib.rkt
View File

@ -29,11 +29,11 @@
(define-syntax-class keyword
#:description (quote "keyword")
(pattern (~fail #:unless (and (syntax? this-syntax) (keyword? (syntax-e this-syntax))))))
(pattern (~fail #:unless (keyword? (syntax-e this-syntax)))))
(define-syntax-class expr
#:description (quote "expression")
(pattern (~fail #:when (and (syntax? this-syntax) (keyword? (syntax-e this-syntax))))))
(pattern (~fail #:when (keyword? (syntax-e this-syntax)))))
;; == Normal syntax classes ==

12
collects/syntax/parse/private/parse.rkt
View File

@ -415,13 +415,13 @@ Conventions:
[#s(pat:integrated _attrs name argu predicate description)
(with-syntax ([(name-attr ...)
(if (identifier? #'name)
#'([#s(attr name 0 #t) x])
#'([#s(attr name 0 #t) x*])
#'())])
;; NOTE: predicate must not assume x (ie, this-syntax) is stx
#'(if (app-argu predicate x argu)
(let-attributes (name-attr ...) k)
(let ([es (cons (expect:thing 'description #t) es)])
(fail (failure pr es)))))])]))
#'(let ([x* (datum->syntax cx x cx)])
(if (app-argu predicate x* argu)
(let-attributes (name-attr ...) k)
(let ([es (cons (expect:thing 'description #t) es)])
(fail (failure pr es))))))])]))
;; (disjunct ???-pattern success (pre:expr ...) (id:id ...)) : expr[Ans]
(define-syntax (disjunct stx)

8
collects/tests/stxparse/test.rkt
View File

@ -387,3 +387,11 @@
#:declare b (nat> (syntax-e #'a))
(void)]))
;; ---- Regression tests
(test-case "pvar is syntax"
;; from clklein 9/21/2011
(check-true (syntax-parse #'(m 1 1 2 1 2 3)
[(_ 1 ... . after-ones:expr)
(syntax? #'after-ones)]))
(void))