mbutterick
/
brag
1
0
Fork 0
Code Issues 3 Pull Requests 1 Projects Releases Wiki Activity

propagate srcloc to error msg (fixes #4)

Browse Source
pull/6/head
Matthew Butterick 7 years ago
parent 79cddb19f2
commit 253062bb9e
1 changed files with 15 additions and 10 deletions
Show Stats Download Patch File Download Diff File

25
brag/brag/codegen/runtime.rkt
Unescape Escape View File

@ -68,24 +68,24 @@
(define (permissive-tokenizer) (define (permissive-tokenizer)
(define next-token (tokenizer-thunk)) (define next-token (tokenizer-thunk))
(let loop ([next-token next-token]) (let loop ([next-token next-token][start no-position][end no-position])
(match next-token (match next-token
[(or (? eof-object?) (? void?)) [(or (? eof-object?) (? void?))
(lookup 'EOF eof no-position no-position)] (lookup 'EOF eof start end)]
[(? symbol?) [(? symbol?)
(lookup next-token next-token no-position no-position)] (lookup next-token next-token start end)]
[(? string?) [(? string?)
(lookup (string->symbol next-token) next-token no-position no-position)] (lookup (string->symbol next-token) next-token start end)]
[(? char?) [(? char?)
(lookup (string->symbol (string next-token)) next-token no-position no-position)] (lookup (string->symbol (string next-token)) next-token start end)]
;; Compatibility ;; Compatibility
[(? lex:token?) [(? lex:token?)
(loop (token (lex:token-name next-token) (loop (token (lex:token-name next-token)
(lex:token-value next-token)))] (lex:token-value next-token)) start end)]
[(token-struct type val offset line column span skip?) [(token-struct type val offset line column span skip?)
(cond [skip? (cond [skip?
@ -108,8 +108,11 @@
((current-tokenizer-error-handler) type val ((current-tokenizer-error-handler) type val
offset line column span)])] offset line column span)])]
;; for the next two cases:
;; carry the token's start and end position into the `a-position-token` recursion
;; so that if an error arises, it's reported as coming from the location of the containing token
[(lex:position-token t s e) [(lex:position-token t s e)
(define a-position-token (loop t)) (define a-position-token (loop t s e))
(lex:position-token (lex:position-token-token a-position-token) (lex:position-token (lex:position-token-token a-position-token)
(if (no-position? (lex:position-token-start-pos a-position-token)) (if (no-position? (lex:position-token-start-pos a-position-token))
s s
@ -119,13 +122,15 @@
(lex:position-token-end-pos a-position-token)))] (lex:position-token-end-pos a-position-token)))]
[(lex:srcloc-token t loc) [(lex:srcloc-token t loc)
(define a-position-token (loop t)) (define s (lex:position (srcloc-position loc) (srcloc-line loc) (srcloc-column loc)))
(define e (lex:position (+ (srcloc-position loc) (srcloc-span loc)) #f #f))
(define a-position-token (loop t s e))
(lex:position-token (lex:position-token-token a-position-token) (lex:position-token (lex:position-token-token a-position-token)
(if (no-position? (lex:position-token-start-pos a-position-token)) (if (no-position? (lex:position-token-start-pos a-position-token))
(lex:position (srcloc-position loc) (srcloc-line loc) (srcloc-column loc)) s
(lex:position-token-start-pos a-position-token)) (lex:position-token-start-pos a-position-token))
(if (no-position? (lex:position-token-start-pos a-position-token)) (if (no-position? (lex:position-token-start-pos a-position-token))
(lex:position (+ (srcloc-position loc) (srcloc-span loc)) #f #f) e
(lex:position-token-end-pos a-position-token)))] (lex:position-token-end-pos a-position-token)))]
[else [else

Write Preview
Loading…
Cancel
Save