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:
parent
219e26b28d
commit
7fd52472b4
|
@ -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)
|
||||
|
|
|
@ -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'
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user