fix codeblock to use location only for current source

This commit is contained in:
Matthew Flatt 2015-06-09 07:09:11 -06:00
parent 2c45064376
commit c1df897ab3

View File

@ -124,6 +124,7 @@
(loop (if (dont-stop? mode) (loop (if (dont-stop? mode)
(dont-stop-val mode) (dont-stop-val mode)
mode))))))] mode))))))]
[program-source 'prog]
[e (parameterize ([read-accept-reader #t]) [e (parameterize ([read-accept-reader #t])
((or expand ((or expand
(lambda (stx) (lambda (stx)
@ -133,7 +134,7 @@
(let ([p (open-input-string bstr)]) (let ([p (open-input-string bstr)])
(port-count-lines! p) (port-count-lines! p)
(let loop () (let loop ()
(let ([v (read-syntax 'prog p)]) (let ([v (read-syntax program-source p)])
(cond (cond
[expand v] [expand v]
[(eof-object? v) null] [(eof-object? v) null]
@ -141,7 +142,9 @@
[ids (let loop ([e e]) [ids (let loop ([e e])
(cond (cond
[(and (identifier? e) [(and (identifier? e)
(syntax-original? e)) (syntax-original? e)
(syntax-position e)
(eq? program-source (syntax-source e)))
(let ([pos (sub1 (syntax-position e))]) (let ([pos (sub1 (syntax-position e))])
(list (list (lambda (str) (list (list (lambda (str)
(to-element (syntax-property (to-element (syntax-property