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:
Matthew Flatt 2015-12-09 17:24:20 -07:00
parent 6b8490b78b
commit 904f83ecf3
2 changed files with 15 additions and 34 deletions

View File

@ -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))))

View File

@ -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))