rely on syntax objects preserving source locations
Rely on the representation of source locations in syntax objects, so that its marshaling can take care of problems with absolute paths.
This commit is contained in:
parent
6b8490b78b
commit
904f83ecf3
|
@ -68,31 +68,26 @@
|
|||
[(_ s e)
|
||||
(if (string? (syntax-e #'s))
|
||||
#'s
|
||||
(with-syntax ([src (syntax-source #'e)]
|
||||
[line (syntax-line #'e)]
|
||||
[col (syntax-column #'e)]
|
||||
[pos (syntax-position #'e)]
|
||||
[span (syntax-column #'e)])
|
||||
#'(check-pre-part e (vector 'src 'line 'col 'pos 'span))))]))
|
||||
(with-syntax ([loc (datum->syntax #f 'loc #'e)])
|
||||
#'(check-pre-part e (quote-syntax loc))))]))
|
||||
|
||||
(define (check-pre-part v s)
|
||||
(define (check-pre-part v loc-stx)
|
||||
(if (pre-part? v)
|
||||
v
|
||||
(error
|
||||
(format
|
||||
"~a: not valid in document body (need a pre-part for decode) in: ~e"
|
||||
(cond
|
||||
[(and (vector-ref s 0)
|
||||
(vector-ref s 1))
|
||||
[(and (syntax-source loc-stx)
|
||||
(syntax-line loc-stx))
|
||||
(format "~a:~a:~a"
|
||||
(vector-ref s 0)
|
||||
(vector-ref s 1)
|
||||
(vector-ref s 2))]
|
||||
[(and (vector-ref s 0)
|
||||
(vector-ref s 3))
|
||||
(syntax-source loc-stx)
|
||||
(syntax-line loc-stx)
|
||||
(syntax-column loc-stx))]
|
||||
[(and (syntax-source loc-stx)
|
||||
(syntax-position loc-stx))
|
||||
(format "~a:::~a"
|
||||
(vector-ref s 0)
|
||||
(vector-ref s 1)
|
||||
(vector-ref s 3))]
|
||||
(syntax-source loc-stx)
|
||||
(syntax-position loc-stx))]
|
||||
[else 'document])
|
||||
v))))
|
||||
|
|
|
@ -3,20 +3,6 @@
|
|||
|
||||
(provide quote-syntax/loc)
|
||||
|
||||
(define-syntax (quote-syntax/loc stx)
|
||||
(syntax-case stx ()
|
||||
[(_ id)
|
||||
(with-syntax ([loc (let ([s #'id])
|
||||
(vector (syntax-source s)
|
||||
(syntax-line s)
|
||||
(syntax-column s)
|
||||
(syntax-position s)
|
||||
(syntax-span s)))])
|
||||
#'(let ([s (*quote-syntax/loc id)])
|
||||
(datum->syntax s (syntax-e s) 'loc s)))]))
|
||||
|
||||
(define-syntax *quote-syntax/loc
|
||||
(syntax-rules ()
|
||||
[(_ (sub ...)) (datum->syntax #f (list (quote-syntax/loc sub) ...))]
|
||||
[(_ id) (quote-syntax id)]))
|
||||
|
||||
;; Source locations are now preserved in the bytecode form of `quote-syntax`:
|
||||
(define-syntax-rule (quote-syntax/loc d)
|
||||
(quote-syntax d))
|
||||
|
|
Loading…
Reference in New Issue
Block a user