adjust double splicing behavior of rename-transformer-parameter

This commit is contained in:
Jay McCarthy 2016-01-14 17:26:46 -05:00
parent 3cb100ba17
commit df29c4e7e2
3 changed files with 25 additions and 7 deletions

View File

@ -139,6 +139,7 @@
#`#,(syntax-local-value #'t)])) #`#,(syntax-local-value #'t)]))
(define-syntax one 1) (define-syntax one 1)
(define-syntax two 2) (define-syntax two 2)
(define-syntax three 3)
(define-rename-transformer-parameter num (define-rename-transformer-parameter num
(make-rename-transformer #'one)) (make-rename-transformer #'one))
(test #t = (slv num) 1) (test #t = (slv num) 1)
@ -146,7 +147,11 @@
(test #t = (slv num) 2)) (test #t = (slv num) 2))
(splicing-syntax-parameterize ([num (make-rename-transformer #'two)]) (splicing-syntax-parameterize ([num (make-rename-transformer #'two)])
(define too (slv num))) (define too (slv num)))
(test #t = too 2)) (test #t = too 2)
(splicing-syntax-parameterize ([num (make-rename-transformer #'two)])
(splicing-syntax-parameterize ([num (make-rename-transformer #'three)])
(define trois (slv num))))
(test #t = trois 3))
;; ---------------------------------------- ;; ----------------------------------------

View File

@ -51,6 +51,22 @@
rt)]) rt)])
sp)) sp))
(define (syntax-parameter-local-value-pre id)
(define-values (rt* rt-target) (syntax-local-value/immediate id (λ () #f)))
(cond
[(not rt-target)
rt*]
[(syntax-parameter? rt*)
rt-target]
[(parameter-binding? rt*)
rt*]
[else
(syntax-parameter-local-value-pre rt-target)]))
(define (syntax-parameter-local-value-for-parameter target)
(or (syntax-parameter-local-value-pre (syntax-local-get-shadower target #t))
(syntax-parameter-local-value-pre target)))
(define (target-value target) (define (target-value target)
(syntax-local-value (syntax-local-get-shadower target #t) (syntax-local-value (syntax-local-get-shadower target #t)
(lambda () (lambda ()
@ -72,7 +88,7 @@
v))) v)))
(define (syntax-parameter-target-parameter target) (define (syntax-parameter-target-parameter target)
(let ([v (target-value target)]) (let ([v (syntax-parameter-local-value-for-parameter target)])
(parameter-binding-param v))) (parameter-binding-param v)))
(define (convert-renamer must-be-renamer?-stx v) (define (convert-renamer must-be-renamer?-stx v)

View File

@ -350,10 +350,7 @@
'transparent)])) 'transparent)]))
(define-for-syntax (parameter-of id) (define-for-syntax (parameter-of id)
(let* ([rt (syntax-local-value id)] (let ([sp (syntax-parameter-local-value id)])
[sp (if (set!-transformer? rt)
(set!-transformer-procedure rt)
rt)])
(syntax-parameter-target-parameter (syntax-parameter-target-parameter
(syntax-parameter-target sp)))) (syntax-parameter-target sp))))