parent
bc34ba884b
commit
990e1f1e30
|
@ -423,6 +423,48 @@
|
||||||
[(eq? v 'do-not-forget-me) #t]
|
[(eq? v 'do-not-forget-me) #t]
|
||||||
[else #f]))))
|
[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
|
;; Check property tracking on `let[rec]-values` binding clauses
|
||||||
|
|
||||||
|
|
|
@ -719,6 +719,11 @@
|
||||||
(cond
|
(cond
|
||||||
[(expand-context-to-parsed? ctx)
|
[(expand-context-to-parsed? ctx)
|
||||||
(and (or keep-for-parsed? keep-for-error?) (datum->syntax #f keep-e s s))]
|
(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
|
[else
|
||||||
(syntax-rearm (datum->syntax (syntax-disarm s) keep-e s s)
|
(syntax-rearm (datum->syntax (syntax-disarm s) keep-e s s)
|
||||||
s)]))
|
s)]))
|
||||||
|
|
|
@ -40577,7 +40577,7 @@ static const char *startup_source =
|
||||||
" 'keep-as-needed119"
|
" 'keep-as-needed119"
|
||||||
"(let-values(((ctx_0) ctx117_0))"
|
"(let-values(((ctx_0) ctx117_0))"
|
||||||
"(let-values(((s_0) s118_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-parsed?_0) keep-for-parsed?112_0))"
|
||||||
"(let-values(((keep-for-error?_0) keep-for-error?113_0))"
|
"(let-values(((keep-for-error?_0) keep-for-error?113_0))"
|
||||||
"(let-values()"
|
"(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))"
|
"(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)"
|
"(datum->syntax$1 #f keep-e_0 s_0 s_0)"
|
||||||
" #f))"
|
" #f))"
|
||||||
|
"(if(if for-track?_0(if(pair? d_0) keep-e_0 #f) #f)"
|
||||||
"(let-values()"
|
"(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"
|
"(define-values"
|
||||||
"(attach-disappeared-transformer-bindings)"
|
"(attach-disappeared-transformer-bindings)"
|
||||||
"(lambda(s_0 trans-idss_0)"
|
"(lambda(s_0 trans-idss_0)"
|
||||||
|
|
Loading…
Reference in New Issue
Block a user