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

syntax/parse: fix ~datum pattern with compound datum

Browse Source
This commit is contained in:
Ryan Culpepper 2016-05-03 04:22:52 -04:00
parent 430e6e9567
commit 9d3c193bcf
3 changed files with 17 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -641,3 +641,7 @@
(check-eq? (x) (void)) (check-eq? (x) (void))
)) ))
;; from Jay McCarthy (4/2016)
(tok (1 2 3) (~datum (1 2 3)) 'ok)
(tok (1 2 . 3) (~datum (1 2 . 3)) 'ok)
(tok (1 . (2 3)) (~datum (1 . (2 3))) 'ok)

8
racket/collects/syntax/parse/private/parse.rkt
View File

@ -545,10 +545,14 @@ Conventions:
k)))) k))))
argu))))] argu))))]
[#s(pat:datum attrs datum) [#s(pat:datum attrs datum)
#`(let ([d (if (syntax? x) (syntax-e x) x)]) (with-syntax ([unwrap-x
(if (atomic-datum-stx? #'datum)
#'(if (syntax? x) (syntax-e x) x)
#'(syntax->datum (datum->syntax #f x)))])
#`(let ([d unwrap-x])
(if (equal? d (quote datum)) (if (equal? d (quote datum))
k k
(fail (failure pr (es-add-atom 'datum es)))))] (fail (failure pr (es-add-atom 'datum es))))))]
[#s(pat:literal attrs literal input-phase lit-phase) [#s(pat:literal attrs literal input-phase lit-phase)
#`(if (and (identifier? x) #`(if (and (identifier? x)
(free-identifier=? x (quote-syntax literal) input-phase lit-phase)) (free-identifier=? x (quote-syntax literal) input-phase lit-phase))

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

@ -26,6 +26,9 @@
;; (mandatory from outside, at least) ;; (mandatory from outside, at least)
(provide/contract (provide/contract
[atomic-datum-stx?
(-> syntax?
boolean?)]
[parse-rhs [parse-rhs
(-> syntax? (or/c false/c (listof sattr?)) boolean? (-> syntax? (or/c false/c (listof sattr?)) boolean?
#:context (or/c false/c syntax?) #:context (or/c false/c syntax?)
@ -73,7 +76,7 @@
;; ---- ;; ----
(define (atomic-datum? stx) (define (atomic-datum-stx? stx)
(let ([datum (syntax-e stx)]) (let ([datum (syntax-e stx)])
(or (null? datum) (or (null? datum)
(boolean? datum) (boolean? datum)
@ -521,7 +524,7 @@
(identifier? #'id) (identifier? #'id)
(parse-pat:id stx decls allow-head?)] (parse-pat:id stx decls allow-head?)]
[datum [datum
(atomic-datum? #'datum) (atomic-datum-stx? #'datum)
(create-pat:datum (syntax->datum #'datum))] (create-pat:datum (syntax->datum #'datum))]
[(~var . rest) [(~var . rest)
(disappeared! stx) (disappeared! stx)