Pretty-up the top-level error messages

Make the output more readable when we have location information for the error.
This commit is contained in:
Justin Ethier 2020-07-23 12:38:01 -04:00
parent e6d654b4a4
commit 7b079d36d3
2 changed files with 11 additions and 5 deletions

View file

@ -955,7 +955,13 @@ Debug options:
;; pointless for users of the compiler, so we don't ;; pointless for users of the compiler, so we don't
;; want to display it. ;; want to display it.
(parameterize ((current-output-port (current-error-port))) (parameterize ((current-output-port (current-error-port)))
(display "Error: ") (cond
((and (string? (car err))
(equal? (substring (car err) 0 8)
"at line "))
(display "Error "))
(else
(display "Error: ")))
(display (car err)) (display (car err))
(display ": ") (display ": ")
(newline) (newline)

View file

@ -239,8 +239,8 @@
;; Does reason already include line/file location info? ;; Does reason already include line/file location info?
(define (reason/line-loc? reason) (define (reason/line-loc? reason)
(and (string? reason) (and (string? reason)
(equal? (substring reason 0 9) (equal? (substring reason 0 8)
"(at line "))) "at line ")))
(let* ((found (assoc expr *source-loc-lis*)) (let* ((found (assoc expr *source-loc-lis*))
(loc-vec (if found (loc-vec (if found
(cdr found) ;; Get value (cdr found) ;; Get value
@ -248,13 +248,13 @@
(msg (if (and loc-vec ;; Have line info (msg (if (and loc-vec ;; Have line info
(not (reason/line-loc? reason))) ;; Not there yet (not (reason/line-loc? reason))) ;; Not there yet
(string-append (string-append
"(at line " "at line "
(number->string (vector-ref loc-vec 1)) (number->string (vector-ref loc-vec 1))
", column " ", column "
(number->string (vector-ref loc-vec 2)) (number->string (vector-ref loc-vec 2))
" of " " of "
(vector-ref loc-vec 0) (vector-ref loc-vec 0)
") " ": "
reason) reason)
reason))) reason)))
(if (pair? args) (if (pair? args)