parent
bc34ba884b
commit
990e1f1e30
|
@ -423,6 +423,48 @@
|
|||
[(eq? v 'do-not-forget-me) #t]
|
||||
[else #f]))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Check that 'origin has the right source location
|
||||
|
||||
(let ()
|
||||
(define m #'(module m racket/base
|
||||
(require (for-syntax racket/base))
|
||||
(let ()
|
||||
(define-values (x y) (values 1 2))
|
||||
x)))
|
||||
(define e (expand m))
|
||||
(define dv-src
|
||||
(let loop ([m m])
|
||||
(cond
|
||||
[(syntax? m)
|
||||
(or (and (eq? (syntax-e m) 'define-values)
|
||||
m)
|
||||
(loop (syntax-e m)))]
|
||||
[(pair? m) (or (loop (car m)) (loop (cdr m)))]
|
||||
[else #f])))
|
||||
(define dv-origin
|
||||
(let loop ([e e])
|
||||
(cond
|
||||
[(syntax? e)
|
||||
(define p (syntax-property e 'origin))
|
||||
(or (let loop ([p p])
|
||||
(cond
|
||||
[(and (identifier? p)
|
||||
(eq? (syntax-e p) 'define-values))
|
||||
p]
|
||||
[(pair? p) (or (loop (car p)) (loop (cdr p)))]
|
||||
[else #f]))
|
||||
(loop (syntax-e e)))]
|
||||
[(pair? e) (or (loop (car e)) (loop (cdr e)))]
|
||||
[else #f])))
|
||||
(test (list (syntax-line dv-src)
|
||||
(syntax-column dv-src)
|
||||
(syntax-span dv-src))
|
||||
list
|
||||
(syntax-line dv-origin)
|
||||
(syntax-column dv-origin)
|
||||
(syntax-span dv-origin)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Check property tracking on `let[rec]-values` binding clauses
|
||||
|
||||
|
|
|
@ -719,6 +719,11 @@
|
|||
(cond
|
||||
[(expand-context-to-parsed? ctx)
|
||||
(and (or keep-for-parsed? keep-for-error?) (datum->syntax #f keep-e s s))]
|
||||
[(and for-track? (pair? d) keep-e)
|
||||
;; Use properties of `s`, but binding and source location of identifier
|
||||
(define id (car d))
|
||||
(syntax-rearm (datum->syntax (syntax-disarm id) keep-e id s)
|
||||
id)]
|
||||
[else
|
||||
(syntax-rearm (datum->syntax (syntax-disarm s) keep-e s s)
|
||||
s)]))
|
||||
|
|
|
@ -40577,7 +40577,7 @@ static const char *startup_source =
|
|||
" 'keep-as-needed119"
|
||||
"(let-values(((ctx_0) ctx117_0))"
|
||||
"(let-values(((s_0) s118_0))"
|
||||
"(let-values()"
|
||||
"(let-values(((for-track?_0) for-track?111_0))"
|
||||
"(let-values(((keep-for-parsed?_0) keep-for-parsed?112_0))"
|
||||
"(let-values(((keep-for-error?_0) keep-for-error?113_0))"
|
||||
"(let-values()"
|
||||
|
@ -40593,8 +40593,12 @@ static const char *startup_source =
|
|||
"(if(let-values(((or-part_0) keep-for-parsed?_0))(if or-part_0 or-part_0 keep-for-error?_0))"
|
||||
"(datum->syntax$1 #f keep-e_0 s_0 s_0)"
|
||||
" #f))"
|
||||
"(if(if for-track?_0(if(pair? d_0) keep-e_0 #f) #f)"
|
||||
"(let-values()"
|
||||
"(syntax-rearm$1(datum->syntax$1(syntax-disarm$1 s_0) keep-e_0 s_0 s_0) s_0))))))))))))))"
|
||||
"(let-values(((id_0)(car d_0)))"
|
||||
"(syntax-rearm$1(datum->syntax$1(syntax-disarm$1 id_0) keep-e_0 id_0 s_0) id_0)))"
|
||||
"(let-values()"
|
||||
"(syntax-rearm$1(datum->syntax$1(syntax-disarm$1 s_0) keep-e_0 s_0 s_0) s_0)))))))))))))))"
|
||||
"(define-values"
|
||||
"(attach-disappeared-transformer-bindings)"
|
||||
"(lambda(s_0 trans-idss_0)"
|
||||
|
|
Loading…
Reference in New Issue
Block a user