fixed quasisyntax to work with prefab struct templates

Prefab struct templates have problems with unsyntax-splicing,
but so do vectors. See commented tests.
This commit is contained in:
Ryan Culpepper 2013-05-04 13:44:52 -04:00
parent 219e26b28d
commit 7fd52472b4
2 changed files with 29 additions and 0 deletions

View File

@ -241,6 +241,16 @@
stx
stx)
bindings)))]
[(prefab-struct-key (syntax-e stx))
(let* ([d (syntax-e stx)]
[key (prefab-struct-key d)]
[fields (cdr (vector->list (struct->vector d)))])
(loop (datum->syntax stx fields stx)
depth
same-k
(lambda (v bindings)
(let ([p (apply make-prefab-struct key (syntax->list v))])
(convert-k (datum->syntax stx p stx stx) bindings)))))]
[else
(same-k)])]))))]
[qq (lambda (orig-stx body mk-final)

View File

@ -1717,6 +1717,25 @@
(dynamic-require ''mm-context-m3 #f))
(test #"1\n2\n" get-output-bytes o))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check `quasisyntax' finds `unsyntax'
(with-syntax ([a #'1] [(c ...) #'(3 4 5)])
(let ([b #'2] [ds (list #'3 #'4 #'5)])
(test '(1 2) syntax->datum (quasisyntax (a (unsyntax b))))
(test '(2 1) syntax->datum (quasisyntax ((unsyntax b) a)))
(test '(1 . 2) syntax->datum (quasisyntax (a unsyntax b)))
(test '((1) (2)) syntax->datum (quasisyntax ((a) ((unsyntax b)))))
(test '#(1 2) syntax->datum (quasisyntax #(a (unsyntax b))))
(test '#(1 2 3 4 5) syntax->datum (quasisyntax #(a (unsyntax b) c ...)))
(test '#s(PS 1 2) syntax->datum (quasisyntax #s(PS a (unsyntax b))))
(test '#s(PS 1 2 3 4 5) syntax->datum (quasisyntax #s(PS a (unsyntax b) c ...)))
#|
(test '#(1 2 3 4 5) syntax->datum (quasisyntax #(a (unsyntax b) (unsyntax-splicing ds))))
(test '#s(PS 1 2 3 4 5) syntax->datum
(quasisyntax #s(PS a (unsyntax b) (unsyntax-splicing ds))))
|#))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check preservation of properties by `quasisyntax'