syntax/parse: fix ~datum pattern with compound datum
This commit is contained in:
parent
430e6e9567
commit
9d3c193bcf
|
@ -641,3 +641,7 @@
|
|||
(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)
|
||||
|
|
|
@ -545,10 +545,14 @@ Conventions:
|
|||
k))))
|
||||
argu))))]
|
||||
[#s(pat:datum attrs datum)
|
||||
#`(let ([d (if (syntax? x) (syntax-e x) x)])
|
||||
(if (equal? d (quote datum))
|
||||
k
|
||||
(fail (failure pr (es-add-atom 'datum es)))))]
|
||||
(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))
|
||||
k
|
||||
(fail (failure pr (es-add-atom 'datum es))))))]
|
||||
[#s(pat:literal attrs literal input-phase lit-phase)
|
||||
#`(if (and (identifier? x)
|
||||
(free-identifier=? x (quote-syntax literal) input-phase lit-phase))
|
||||
|
|
|
@ -26,6 +26,9 @@
|
|||
;; (mandatory from outside, at least)
|
||||
|
||||
(provide/contract
|
||||
[atomic-datum-stx?
|
||||
(-> syntax?
|
||||
boolean?)]
|
||||
[parse-rhs
|
||||
(-> syntax? (or/c false/c (listof sattr?)) boolean?
|
||||
#:context (or/c false/c syntax?)
|
||||
|
@ -73,7 +76,7 @@
|
|||
|
||||
;; ----
|
||||
|
||||
(define (atomic-datum? stx)
|
||||
(define (atomic-datum-stx? stx)
|
||||
(let ([datum (syntax-e stx)])
|
||||
(or (null? datum)
|
||||
(boolean? datum)
|
||||
|
@ -521,7 +524,7 @@
|
|||
(identifier? #'id)
|
||||
(parse-pat:id stx decls allow-head?)]
|
||||
[datum
|
||||
(atomic-datum? #'datum)
|
||||
(atomic-datum-stx? #'datum)
|
||||
(create-pat:datum (syntax->datum #'datum))]
|
||||
[(~var . rest)
|
||||
(disappeared! stx)
|
||||
|
|
Loading…
Reference in New Issue
Block a user