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

better errors

Browse Source 
svn: r6810
This commit is contained in:
Eli Barzilay 2007-07-03 17:26:28 +00:00
parent cec0624357
commit 760e120e6b
1 changed files with 14 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/scribble/reader.ss
View File

@ -171,9 +171,14 @@
(define (read-error* line col pos span msg . xs) (define (read-error* line col pos span msg . xs)
(let* ([eof? (and (eq? 'eof msg) (pair? xs))] (let* ([eof? (and (eq? 'eof msg) (pair? xs))]
[msg (apply format (if eof? xs (cons msg xs)))] [msg (apply format (if eof? xs (cons msg xs)))]
[msg (if source-name [loc (cond [(and line col) (format "at ~a:~a" line col)]
(format "~a (when reading ~a)" msg source-name) [pos (format "at #~a" pos)]
msg)]) [else #f])]
[loc (cond [(and source-name loc)
(format "when reading ~a ~a" source-name loc)]
[source-name (format "when reading ~a" source-name)]
[else loc])]
[msg (if loc (format "~a (~a)" msg loc) msg)])
((if eof? raise-read-error raise-read-eof-error) ((if eof? raise-read-error raise-read-eof-error)
msg source-name line col pos span))) msg source-name line col pos span)))
(define (read-error msg . xs) (define (read-error msg . xs)
@ -331,7 +336,6 @@
(define (get-lines* re:begin re:end re:item end-token) (define (get-lines* re:begin re:end re:item end-token)
;; re:begin, re:end, end-token can be false if start-inside? is #t ;; re:begin, re:end, end-token can be false if start-inside? is #t
(let-values ([(start-line start-col start-pos) (port-next-location inp)])
(let loop ([lvl 0] [r '()]) (let loop ([lvl 0] [r '()])
(let-values ([(line col pos) (port-next-location inp)]) (let-values ([(line col pos) (port-next-location inp)])
(define (make-stx sexpr) (define (make-stx sexpr)
@ -396,11 +400,13 @@
r)))] r)))]
[(*peek #rx#"^$") [(*peek #rx#"^$")
(if end-token (if end-token
(read-error* start-line start-col start-pos (read-error 'eof "missing closing `~a'~a" end-token
(and pos start-pos (- pos start-pos)) (if (and start-line start-col)
'eof "missing closing `~a'" end-token) (format " for command at ~a:~a"
start-line start-col)
""))
(done-lines r))] (done-lines r))]
[else (read-error "internal error [get-lines*]")]))))) [else (read-error "internal error [get-lines*]")]))))
(define (get-lines) (define (get-lines)
(cond [(*skip re:lines-begin) (cond [(*skip re:lines-begin)