Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-15 16:57:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Clean up error messages, provide filename if able

Browse source
This commit is contained in:
Justin Ethier 2020-07-21 22:35:47 -04:00
parent de1a97fbe7
commit 0d25e5e122
3 changed files with 19 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
cyclone.scm
View file

@ -957,6 +957,7 @@ Debug options:
(parameterize ((current-output-port (current-error-port))) (parameterize ((current-output-port (current-error-port)))
(display "Error: ") (display "Error: ")
(display (car err)) (display (car err))
(display ": ")
(newline) (newline)
(for-each (for-each
(lambda (obj) (lambda (obj)

12
scheme/base.sld
View file

@ -243,19 +243,17 @@
(if loc-vec (if loc-vec
(error (error
(string-append (string-append
"invalid syntax " "("
reason
" in "
(vector-ref loc-vec 0) (vector-ref loc-vec 0)
" line " " 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))
") "
reason)
expr) expr)
(error (error
(string-append reason
"invalid syntax "
reason)
expr)))) expr))))
;; Features implemented by this Scheme ;; Features implemented by this Scheme

20
scheme/read.sld
View file

@ -73,7 +73,7 @@
#f))) #f)))
(let ((result (parse fp ssi! fname))) (let ((result (parse fp ssi! fname)))
(if (Cyc-opaque? result) (if (Cyc-opaque? result)
(read-error fp "unexpected closing parenthesis") (read-error fp fname "unexpected closing parenthesis")
result))))) result)))))
;; Read given file, collecting source location information so we ;; Read given file, collecting source location information so we
@ -115,14 +115,20 @@
" Cyc_io_read_token(data, k, port);") " Cyc_io_read_token(data, k, port);")
(define-c read-error (define-c read-error
"(void *data, int argc, closure _, object k, object port, object msg)" "(void *data, int argc, closure _, object k, object port, object filename, object msg)"
" char buf[1024]; " char buf[1024];
port_type *p; port_type *p;
Cyc_check_port(data, port); Cyc_check_port(data, port);
Cyc_check_str(data, msg); Cyc_check_str(data, msg);
p = ((port_type *)port); p = ((port_type *)port);
snprintf(buf, 1023, \"(line %d, column %d): %s\", if (Cyc_is_string(filename) == boolean_t) {
p->line_num, p->col_num, string_str(msg)); snprintf(buf, 1023, \"(%s line %d, column %d): %s\",
string_str(filename), p->line_num, p->col_num,
string_str(msg));
} else {
snprintf(buf, 1023, \"(line %d, column %d): %s\",
p->line_num, p->col_num, string_str(msg));
}
Cyc_rt_raise_msg(data, buf);") Cyc_rt_raise_msg(data, buf);")
(define-c Cyc-opaque-eq? (define-c Cyc-opaque-eq?
@ -203,7 +209,7 @@
(t (parse fp ssi! fname))) (t (parse fp ssi! fname)))
(cond (cond
((eof-object? t) ((eof-object? t)
(read-error fp "missing closing parenthesis")) (read-error fp fname "missing closing parenthesis"))
((Cyc-opaque-eq? t #\)) ((Cyc-opaque-eq? t #\))
(if (and (> (length lis) 2) (if (and (> (length lis) 2)
(equal? (cadr lis) *sym-dot*)) (equal? (cadr lis) *sym-dot*))
@ -265,7 +271,7 @@
(t (parse fp ssi! fname))) (t (parse fp ssi! fname)))
(cond (cond
((eof-object? t) ((eof-object? t)
(read-error fp "missing closing parenthesis")) (read-error fp fname "missing closing parenthesis"))
((Cyc-opaque-eq? t #\)) ((Cyc-opaque-eq? t #\))
(list->vector (reverse lis))) (list->vector (reverse lis)))
(else (else
@ -275,7 +281,7 @@
(t (parse fp ssi! fname))) (t (parse fp ssi! fname)))
(cond (cond
((eof-object? t) ((eof-object? t)
(read-error fp "missing closing parenthesis")) (read-error fp fname "missing closing parenthesis"))
((Cyc-opaque-eq? t #\)) ((Cyc-opaque-eq? t #\))
(apply bytevector (reverse lis))) (apply bytevector (reverse lis)))
(else (else