[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/02: Improve read error reporting
From: |
Andy Wingo |
Subject: |
[Guile-commits] 01/02: Improve read error reporting |
Date: |
Wed, 17 Feb 2021 09:37:22 -0500 (EST) |
wingo pushed a commit to branch master
in repository guile.
commit 6353b448cc263eb915dded9308d6567567196b19
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Wed Feb 17 14:54:53 2021 +0100
Improve read error reporting
* module/ice-9/read.scm (read): Issue properly formatted read-errors, as
users expect.
---
module/ice-9/read.scm | 93 +++++++++++++++++++++++++++------------------------
1 file changed, 50 insertions(+), 43 deletions(-)
diff --git a/module/ice-9/read.scm b/module/ice-9/read.scm
index be072f9..af9cfd2 100644
--- a/module/ice-9/read.scm
+++ b/module/ice-9/read.scm
@@ -134,6 +134,8 @@
(define (peek) (peek-char port))
(define filename (port-filename port))
(define (get-pos) (cons (port-line port) (port-column port)))
+ ;; We are only ever interested in whether an object is a char or not.
+ (define (eof-object? x) (not (char? x)))
(define accumulator (open-output-string))
(define-syntax-rule (accumulate proc)
(begin
@@ -159,8 +161,17 @@
(column . ,(1- column)))))
datum)
- (define (input-error msg . args)
- (apply error msg args))
+ (define (input-error msg args)
+ (scm-error 'read-error #f
+ (format #f "~A:~S:~S: ~A"
+ (or filename "#<unknown port>")
+ (port-line port) (port-column port)
+ msg)
+ args #f))
+
+ (define-syntax-rule (error msg arg ...)
+ (let ((args (list arg ...)))
+ (input-error msg args)))
(define (read-semicolon-comment)
(let ((ch (next)))
@@ -237,13 +248,14 @@
(finish-curly-infix
(let lp ((ch (next-non-whitespace)))
(when (eof-object? ch)
- (input-error "unexpected end of input while searching for " rdelim))
+ (error "unexpected end of input while searching for: ~A"
+ rdelim))
(cond
((eqv? ch rdelim) '())
((or (eqv? ch #\))
(and (eqv? ch #\]) (or (square-brackets?) (curly-infix?)))
(and (eqv? ch #\}) (curly-infix?)))
- (input-error "mismatched close paren" ch))
+ (error "mismatched close paren: ~A" ch))
(else
(let ((expr (read-expr ch)))
;; Note that it is possible for scm_read_expression to
@@ -253,7 +265,7 @@
(let* ((tail (read-expr (next-non-whitespace)))
(close (next-non-whitespace)))
(unless (eqv? close rdelim)
- (input-error "missing close paren" rdelim))
+ (error "missing close paren: ~A" close))
tail)
(cons expr (lp (next-non-whitespace))))))))))
@@ -278,9 +290,9 @@
((hex-digit ch) => (lambda (digit) (lp (+ (* 16 res) digit))))
((eqv? ch #\;) (integer->char res))
(else
- (input-error "invalid character in escape sequence: ~S"
ch)))))))
+ (error "invalid character in escape sequence: ~S" ch)))))))
(else
- (input-error "invalid character in escape sequence: ~S" ch)))))
+ (error "invalid character in escape sequence: ~S" ch)))))
(define (read-fixed-hex-escape len)
(let lp ((len len) (res 0))
@@ -292,7 +304,7 @@
(lambda (digit)
(lp (1- len) (+ (* res 16) digit))))
(else
- (input-error "invalid character in escape sequence: ~S" ch)))))))
+ (error "invalid character in escape sequence: ~S" ch)))))))
(define (read-string rdelim)
(accumulate
@@ -302,11 +314,11 @@
(unless (eqv? ch rdelim)
(cond
((eof-object? ch)
- (input-error "unexpected end of input while reading string"))
+ (error "unexpected end of input while reading string"))
((eqv? ch #\\)
(let ((ch (next)))
(when (eof-object? ch)
- (input-error "unexpected end of input while reading
string"))
+ (error "unexpected end of input while reading string"))
(case ch
((#\newline)
(when (hungry-eol-escapes?)
@@ -341,7 +353,7 @@
(put (read-fixed-hex-escape 8)))
(else
(unless (eqv? ch rdelim)
- (input-error "invalid character in escape sequence: ~S"
ch))
+ (error "invalid character in escape sequence: ~S" ch))
(put ch)))
(lp)))
(else
@@ -352,7 +364,7 @@
(let ((ch (next)))
(cond
((eof-object? ch)
- (input-error "unexpected end of input after #\\"))
+ (error "unexpected end of input after #\\"))
((delimiter? ch)
ch)
(else
@@ -414,7 +426,7 @@
((named-char tok C0-control-charnames))
((named-char tok alt-charnames))
(else
- (input-error "unknown character name ~a" tok))))))))
+ (error "unknown character name ~a" tok))))))))
(define (read-vector)
(list->vector (read-parenthesized #\))))
@@ -448,7 +460,7 @@
(define (read-bytevector)
(define (expect ch)
(unless (eqv? (next) ch)
- (input-error "invalid bytevector prefix" ch)))
+ (error "invalid bytevector prefix" ch)))
(expect #\u)
(expect #\8)
(expect #\()
@@ -479,11 +491,10 @@
(define (read-keyword)
(let ((ch (next-non-whitespace)))
(when (eof-object? ch)
- (input-error "end of input while reading keyword"))
+ (error "end of input while reading keyword"))
(let ((expr (read-expr ch)))
(unless (symbol? expr)
- (input-error "keyword prefix #: not followed by a symbol: ~a"
- expr))
+ (error "keyword prefix #: not followed by a symbol: ~a" expr))
(symbol->keyword expr))))
(define (read-array ch)
@@ -507,14 +518,14 @@
(define (read-rank ch)
(let-values (((ch rank) (read-decimal-integer ch 1)))
(when (< rank 0)
- (input-error "array rank must be non-negative"))
+ (error "array rank must be non-negative"))
(when (eof-object? ch)
- (input-error "unexpected end of input while reading array"))
+ (error "unexpected end of input while reading array"))
(values ch rank)))
(define (read-tag ch)
(let lp ((ch ch) (chars '()))
(when (eof-object? ch)
- (input-error "unexpected end of input while reading array"))
+ (error "unexpected end of input while reading array"))
(if (memv ch '(#\( #\@ @\:))
(values ch
(if (null? chars)
@@ -529,9 +540,9 @@
(read-decimal-integer (next) 0)
(values ch #f))))
(when (and len (< len 0))
- (input-error "array length must be non-negative"))
+ (error "array length must be non-negative"))
(when (eof-object? ch)
- (input-error "unexpected end of input while reading array"))
+ (error "unexpected end of input while reading array"))
(values ch
(if len
(if (zero? lbnd)
@@ -546,16 +557,16 @@
(values ch alt)))
(define (read-elements ch rank)
(unless (eqv? ch #\()
- (input-error "missing '(' in vector or array literal"))
+ (error "missing '(' in vector or array literal"))
(let ((elts (read-parenthesized #\))))
(if (zero? rank)
(begin
;; Handle special print syntax of rank zero arrays; see
;; scm_i_print_array for a rationale.
(when (null? elts)
- (input-error "too few elements in array literal, need 1"))
+ (error "too few elements in array literal, need 1"))
(unless (null? (cdr elts))
- (input-error "too many elements in array literal, need 1"))
+ (error "too many elements in array literal, need 1"))
(car elts))
elts)))
(let*-values (((ch rank) (read-rank ch))
@@ -563,20 +574,19 @@
((ch shape) (read-shape ch rank))
((elts) (read-elements ch rank)))
(when (and (pair? shape) (not (eqv? (length shape) rank)))
- (input-error
- "the number of shape specifications must match the array rank"))
+ (error "the number of shape specifications must match the array rank"))
(list->typed-array tag shape elts)))
(define (read-number-and-radix ch)
(let ((tok (string-append "#" (read-token ch))))
(or (string->number tok)
- (input-error "unknown # object"))))
+ (error "unknown # object" tok))))
(define (read-extended-symbol)
(define (next-not-eof)
(let ((ch (next)))
(when (eof-object? ch)
- (input-error "end of input while reading symbol"))
+ (error "end of input while reading symbol"))
ch))
(string->symbol
(list->string
@@ -610,14 +620,14 @@
;; Have already read "#\n" -- now read "il".
(let ((id (read-mixed-case-symbol #\n)))
(unless (eq? id 'nil)
- (input-error "unexpected input while reading #nil: ~a" id))
+ (error "unexpected input while reading #nil: ~a" id))
#nil))
(define (read-sharp)
(let* ((ch (next)))
(cond
((eof-object? ch)
- (input-error "unexpected end of input after #"))
+ (error "unexpected end of input after #"))
((read-hash-procedure ch)
=> (lambda (proc) (proc ch)))
(else
@@ -645,7 +655,7 @@
(list 'unsyntax (read-expr (next-non-whitespace)))))
((#\n) (read-nil))
(else
- (input-error "Unknown # object: ~S" ch)))))))
+ (error "Unknown # object: ~S" ch)))))))
(define (read-number ch)
(let* ((str (read-token ch)))
@@ -702,24 +712,21 @@
;; FIXME: read-sharp should recur if we read a comment
(read-sharp))
((#\))
- (input-error "unexpected \")\""))
+ (error "unexpected \")\""))
((#\})
(if (curly-infix?)
- (input-error "unexpected \"}\"")
+ (error "unexpected \"}\"")
(read-mixed-case-symbol ch)))
((#\])
(if (square-brackets?)
- (input-error "unexpected \"]\"")
+ (error "unexpected \"]\"")
(read-mixed-case-symbol ch)))
- ((#f)
- ;; EOF.
- the-eof-object)
((#\:)
(if (eq? (keyword-style) keyword-style-prefix)
;; FIXME: Don't skip whitespace here.
(let ((ch (next-non-whitespace)))
(when (eof-object? ch)
- (input-error "unexpected end of input while reading :keyword"))
+ (error "unexpected end of input while reading :keyword"))
(symbol->keyword (read-expr ch)))
(read-mixed-case-symbol ch)))
((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\+ #\- #\.)
@@ -764,7 +771,7 @@
(let ((ch (next)))
(cond
((eof-object? ch)
- (input-error "unexpected end of input after #!"))
+ (error "unexpected end of input after #!"))
(else
(string->symbol
(take-while ch (lambda (ch)
@@ -776,7 +783,7 @@
(let lp ((ch (next)))
(cond
((eof-object? ch)
- (input-error "unexpected end of input while looking for !#"))
+ (error "unexpected end of input while looking for !#"))
((eqv? ch #\!)
(let ((ch (next)))
(if (eqv? ch #\#)
@@ -828,7 +835,7 @@
;; We have read #|, now looking for |#.
(let ((ch (next)))
(when (eof-object? ch)
- (input-error "unterminated `#| ... |#' comment"))
+ (error "unterminated `#| ... |#' comment"))
(cond
((and (eqv? ch #\|) (eqv? (peek) #\#))
;; Done.
@@ -856,7 +863,7 @@
(next)
(let ((ch (next-non-whitespace)))
(when (eof-object? ch)
- (input-error "no expression after #; comment"))
+ (error "no expression after #; comment"))
(read-expr ch))
(next-non-whitespace))
((#\|)