suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

show line/column information for parsing errors

Browse Source
This commit is contained in:
Jon Rafkind 2011-07-27 11:32:29 -06:00
parent 5f4c577d5b
commit cd62f1983f
1 changed files with 25 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
collects/honu/core/read.rkt
View File

@ -186,7 +186,10 @@
(define (add-dispatch-rule table rule) (define (add-dispatch-rule table rule)
(cons rule table)) (cons rule table))
(define ((do-fail kind) current tokens table) (define ((do-fail kind) current tokens table)
(error 'parse "expected a right ~a" kind)) (define line (syntax-line (car current)))
(define column (add1 (+ (syntax-span (car current))
(syntax-column (car current)))))
(error 'parse "expected a ~a character at line ~a column ~a" kind line column))
;; add a rule to the dispatch table to expect an ending token then ;; add a rule to the dispatch table to expect an ending token then
;; parse the sub-tree and continue ;; parse the sub-tree and continue
(define (make-encloser head failure-name next) (define (make-encloser head failure-name next)
@ -199,9 +202,9 @@
(cdr tokens) added)) (cdr tokens) added))
(do-parse (cons sub-tree current) unparsed table))) (do-parse (cons sub-tree current) unparsed table)))
(define do-left-parens (make-encloser '#%parens "parentheses" right-parens?)) (define do-left-parens (make-encloser '#%parens ")" right-parens?))
(define do-left-bracket (make-encloser '#%bracket "bracket" right-bracket?)) (define do-left-bracket (make-encloser '#%bracket "}" right-bracket?))
(define do-left-brace (make-encloser '#%braces "brace" right-brace?)) (define do-left-brace (make-encloser '#%braces "]" right-brace?))
(define dispatch-table (list [list atom? do-atom] (define dispatch-table (list [list atom? do-atom]
[list left-parens? do-left-parens] [list left-parens? do-left-parens]
@ -210,10 +213,19 @@
[list null? do-empty])) [list null? do-empty]))
(define (do-parse current tokens table) (define (do-parse current tokens table)
(define (fail tokens)
(if (null? tokens)
(error 'parse "error while parsing")
(let ([first (car tokens)])
;; hack to get the current failure behavior
(do-parse current '() table)
(define line (position-line (position-token-start-pos first)))
(define column (position-col (position-token-start-pos first)))
(error 'parse "error while parsing on line ~a column ~a" line column))))
;; (printf "do parse ~a [tokens] ~a table ~a\n" (strip current) (strip tokens) table) ;; (printf "do parse ~a [tokens] ~a table ~a\n" (strip current) (strip tokens) table)
(let loop ([use table]) (let loop ([use table])
(cond (cond
[(null? use) (error 'parse "unable to parse ~a" (strip tokens))] [(null? use) (fail tokens)]
[(let ([dispatcher (caar use)]) [(let ([dispatcher (caar use)])
(dispatcher tokens)) (dispatcher tokens))
(define action (cadar use)) (define action (cadar use))
@ -240,6 +252,10 @@
(define (honu-read [port (current-input-port)]) (define (honu-read [port (current-input-port)])
(syntax->datum (honu-read-syntax #f port))) (syntax->datum (honu-read-syntax #f port)))
(define (count-lines port)
(port-count-lines! port)
port)
(test-case (test-case
"Basic tests" "Basic tests"
(check-equal? (strip (lex-string "5")) (check-equal? (strip (lex-string "5"))
@ -272,10 +288,8 @@
(check-equal? (strip (lex-string "8 /* aosidfjasdf329023 */ 5")) (check-equal? (strip (lex-string "8 /* aosidfjasdf329023 */ 5"))
(list (token-number 8) (list (token-number 8)
(token-number 5))) (token-number 5)))
(check-equal? (honu-read (open-input-string "f(5)"))
'(f (#%parens 5)))
(check-exn exn:fail? (lambda ()
(honu-read (count-lines (open-input-string "({)}")))))
) )
#|
(parse #f (lex-string "f{(1 1) [(5)]}"))
(honu-read-syntax (open-input-string "f(5)"))
(honu-read (open-input-string "f(5)"))
|#