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

fix `quasisyntax' to better preserve syntax properties

Browse Source 
Closes PR 13357
This commit is contained in:
Matthew Flatt 2012-12-12 08:34:19 -07:00
parent dbffc840a9
commit dd5b999c64
2 changed files with 20 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/racket/private/qqstx.rkt
View File

@ -108,6 +108,7 @@
(list* (syntax temp)
(quote-syntax ...)
rest-v)
stx
stx)
(with-syntax ([check check-splicing-list-id])
(cons #'[(temp (... ...)) (check x (quote-syntax ctx))]
@ -122,6 +123,7 @@
(convert-k (datum->syntax
stx
(cons x-v rest-v)
stx
stx)
(append x-bindings
rest-bindings))))])
@ -137,6 +139,7 @@
(datum->syntax
(stx-car stx)
(list (stx-car (stx-car stx)) x-v)
(stx-car stx)
(stx-car stx))
x-bindings)])
(loop (syntax rest) depth
@ -161,6 +164,7 @@
(convert-k (datum->syntax
stx
(list (stx-car stx) v)
stx
stx)
bindings)))]
[_
@ -175,6 +179,7 @@
(convert-k (datum->syntax
stx
l
stx
stx)
bindings))])
(cond
@ -201,7 +206,8 @@
(lambda (a a-bindings)
(convert-k (cons (datum->syntax
(car l)
a
a
(car l)
(car l))
(cdr l))
a-bindings))))
@ -214,6 +220,7 @@
(convert-k (cons (datum->syntax
(car l)
a
(car l)
(car l))
rest)
(append a-bindings
@ -231,6 +238,7 @@
(convert-k (datum->syntax
stx
(list->vector (syntax->list v))
stx
stx)
bindings)))]
[else

11
collects/tests/racket/stx.rktl
View File

@ -1711,6 +1711,17 @@
(dynamic-require ''mm-context-m3 #f))
(test #"1\n2\n" get-output-bytes o))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check preservation of properties by `quasisyntax'
(test #\[ syntax-property #'[x] 'paren-shape)
(test #\[ syntax-property #`[x] 'paren-shape)
(test #\[ syntax-property #`[x #,#'y] 'paren-shape)
(test #\[ syntax-property #`[0 #,@(list #'1 #'2)] 'paren-shape)
(test #\[ syntax-property #`[0 #,@null] 'paren-shape)
(test #\[ syntax-property (quasisyntax [x (unsyntax (syntax y))]) 'paren-shape)
(test #\[ syntax-property (quasisyntax [x y]) 'paren-shape)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)