From f1e7c3a2db218f5c41b43335aad9981f57bb1bab Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sun, 28 Jun 2009 14:52:52 +0900 Subject: [PATCH] reporting source file and line number for compile-time errors --- eval.c | 8 ++++++-- include/chibi/sexp.h | 13 +++++++----- main.c | 17 ++++++++++------ sexp.c | 47 ++++++++++++++++++++++++++------------------ 4 files changed, 53 insertions(+), 32 deletions(-) diff --git a/eval.c b/eval.c index 74838c26..871feb9d 100644 --- a/eval.c +++ b/eval.c @@ -368,7 +368,8 @@ static sexp sexp_compile_error(sexp ctx, char *message, sexp obj) { irritants = sexp_list1(ctx, obj); msg = sexp_c_string(ctx, message, -1); exn = sexp_make_exception(ctx, the_compile_error_symbol, msg, irritants, - SEXP_FALSE, SEXP_FALSE, SEXP_FALSE); + SEXP_FALSE, (sexp_pairp(obj) ? + sexp_pair_source(obj) : SEXP_FALSE)); sexp_gc_release(ctx, irritants, s_irr); return exn; } @@ -558,7 +559,9 @@ static sexp analyze_define (sexp ctx, sexp x) { res = sexp_compile_error(ctx, "bad define syntax", x); } else { name = (sexp_pairp(sexp_cadr(x)) ? sexp_caadr(x) : sexp_cadr(x)); - if (sexp_env_lambda(env) && sexp_lambdap(sexp_env_lambda(env))) { + if (! sexp_idp(name)) { + res = sexp_compile_error(ctx, "can't define a non-symbol", x); + } else if (sexp_env_lambda(env) && sexp_lambdap(sexp_env_lambda(env))) { tmp = sexp_cons(ctx, name, sexp_context_lambda(ctx)); sexp_push(ctx, sexp_env_bindings(env), tmp); sexp_push(ctx, sexp_lambda_sv(sexp_env_lambda(env)), name); @@ -1894,6 +1897,7 @@ sexp sexp_load (sexp ctx, sexp source, sexp env) { sexp_print_exception(ctx, in, out); res = in; } else { + sexp_port_sourcep(in) = 1; while ((x=sexp_read(ctx, in)) != (sexp) SEXP_EOF) { res = sexp_eval(ctx2, x); if (sexp_exceptionp(res)) diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index 9f8005cf..8ab96d98 100644 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -114,6 +114,7 @@ struct sexp_struct { } type; struct { sexp car, cdr; + sexp source; } pair; struct { sexp_uint_t length; @@ -129,12 +130,12 @@ struct sexp_struct { struct { FILE *stream; char *buf; - sexp_uint_t offset, line, size, openp; + sexp_uint_t offset, line, size, openp, sourcep; sexp name; sexp cookie; } port; struct { - sexp kind, message, irritants, procedure, file, line; + sexp kind, message, irritants, procedure, source; } exception; struct { char sign; @@ -374,6 +375,7 @@ sexp sexp_make_flonum(sexp ctx, double f); #define sexp_port_name(p) ((p)->value.port.name) #define sexp_port_line(p) ((p)->value.port.line) #define sexp_port_openp(p) ((p)->value.port.openp) +#define sexp_port_sourcep(p) ((p)->value.port.sourcep) #define sexp_port_cookie(p) ((p)->value.port.cookie) #define sexp_port_buf(p) ((p)->value.port.buf) #define sexp_port_size(p) ((p)->value.port.size) @@ -383,8 +385,7 @@ sexp sexp_make_flonum(sexp ctx, double f); #define sexp_exception_message(p) ((p)->value.exception.message) #define sexp_exception_irritants(p) ((p)->value.exception.irritants) #define sexp_exception_procedure(p) ((p)->value.exception.procedure) -#define sexp_exception_file(p) ((p)->value.exception.file) -#define sexp_exception_line(p) ((p)->value.exception.line) +#define sexp_exception_source(p) ((p)->value.exception.source) #define sexp_bytecode_length(x) ((x)->value.bytecode.length) #define sexp_bytecode_name(x) ((x)->value.bytecode.name) @@ -498,6 +499,8 @@ sexp sexp_make_flonum(sexp ctx, double f); #define sexp_push(ctx, ls, x) ((ls) = sexp_cons((ctx), (x), (ls))) #define sexp_insert(ctx, ls, x) ((sexp_memq(NULL, (x), (ls)) != SEXP_FALSE) ? (ls) : sexp_push((ctx), (ls), (x))) +#define sexp_pair_source(x) ((x)->value.pair.source) + #define sexp_car(x) ((x)->value.pair.car) #define sexp_cdr(x) ((x)->value.pair.cdr) @@ -576,7 +579,7 @@ sexp sexp_make_output_port(sexp ctx, FILE* out, sexp name); sexp sexp_make_input_string_port(sexp ctx, sexp str); sexp sexp_make_output_string_port(sexp ctx); sexp sexp_get_output_string(sexp ctx, sexp port); -sexp sexp_make_exception(sexp ctx, sexp kind, sexp message, sexp irritants, sexp procedure, sexp file, sexp line); +sexp sexp_make_exception(sexp ctx, sexp kind, sexp message, sexp irritants, sexp procedure, sexp source); sexp sexp_user_exception (sexp ctx, sexp self, char *message, sexp obj); sexp sexp_type_exception (sexp ctx, char *message, sexp obj); sexp sexp_range_exception (sexp ctx, sexp obj, sexp start, sexp end); diff --git a/main.c b/main.c index 7854beba..1d1f88b9 100644 --- a/main.c +++ b/main.c @@ -52,6 +52,7 @@ void repl (sexp ctx) { in = sexp_eval_string(ctx, "(current-input-port)"); out = sexp_eval_string(ctx, "(current-output-port)"); err = sexp_eval_string(ctx, "(current-error-port)"); + sexp_port_sourcep(in) = 1; while (1) { sexp_write_string(ctx, "> ", out); sexp_flush(ctx, out); @@ -98,6 +99,8 @@ void run_main (int argc, char **argv) { res = sexp_eval(ctx, res); if (sexp_exceptionp(res)) { sexp_print_exception(ctx, res, out); + quit = 1; + break; } else if (argv[i][1] == 'p') { sexp_write(ctx, res, out); sexp_write_char(ctx, '\n', out); @@ -123,12 +126,14 @@ void run_main (int argc, char **argv) { if (! quit) { if (! init_loaded) - sexp_load(ctx, str=find_module_file(ctx, sexp_init_file), env); - if (i < argc) - for ( ; i < argc; i++) - sexp_load(ctx, str=sexp_c_string(ctx, argv[i], -1), env); - else - repl(ctx); + res = sexp_load(ctx, str=find_module_file(ctx, sexp_init_file), env); + if (! sexp_exceptionp(res)) { + if (i < argc) + for ( ; i < argc; i++) + sexp_load(ctx, str=sexp_c_string(ctx, argv[i], -1), env); + else + repl(ctx); + } } sexp_gc_release(ctx, str, s_str); diff --git a/sexp.c b/sexp.c index fb86efa3..9b909936 100644 --- a/sexp.c +++ b/sexp.c @@ -69,7 +69,7 @@ static struct sexp_struct sexp_type_specs[] = { _DEF_TYPE(SEXP_FIXNUM, 0, 0, 0, 0, 0, 0, 0, "fixnum"), _DEF_TYPE(SEXP_CHAR, 0, 0, 0, 0, 0, 0, 0, "char"), _DEF_TYPE(SEXP_BOOLEAN, 0, 0, 0, 0, 0, 0, 0, "boolean"), - _DEF_TYPE(SEXP_PAIR, sexp_offsetof(pair, car), 2, 0, 0, sexp_sizeof(pair), 0, 0, "pair"), + _DEF_TYPE(SEXP_PAIR, sexp_offsetof(pair, car), 3, 0, 0, sexp_sizeof(pair), 0, 0, "pair"), _DEF_TYPE(SEXP_SYMBOL, sexp_offsetof(symbol, string), 1, 0, 0, sexp_sizeof(symbol), 0, 0, "symbol"), _DEF_TYPE(SEXP_STRING, 0, 0, 0, 0, sexp_sizeof(string)+1, sexp_offsetof(string, length), 1, "string"), _DEF_TYPE(SEXP_VECTOR, sexp_offsetof(vector, data), 0, sexp_offsetof(vector, length), 1, sexp_sizeof(vector), sexp_offsetof(vector, length), 4, "vector"), @@ -106,14 +106,13 @@ static struct sexp_struct sexp_type_specs[] = { /***************************** exceptions *****************************/ sexp sexp_make_exception (sexp ctx, sexp kind, sexp message, sexp irritants, - sexp procedure, sexp file, sexp line) { + sexp procedure, sexp source) { sexp exn = sexp_alloc_type(ctx, exception, SEXP_EXCEPTION); sexp_exception_kind(exn) = kind; sexp_exception_message(exn) = message; sexp_exception_irritants(exn) = irritants; sexp_exception_procedure(exn) = procedure; - sexp_exception_file(exn) = file; - sexp_exception_line(exn) = line; + sexp_exception_source(exn) = source; return exn; } @@ -129,7 +128,7 @@ sexp sexp_user_exception (sexp ctx, sexp self, char *message, sexp irritants) { str = sexp_c_string(ctx, message, -1), ((sexp_pairp(irritants) || sexp_nullp(irritants)) ? irritants : (irr = sexp_list1(ctx, irritants))), - self, SEXP_FALSE, SEXP_FALSE); + self, SEXP_FALSE); sexp_gc_release(ctx, sym, s_sym); return res; } @@ -145,7 +144,7 @@ sexp sexp_type_exception (sexp ctx, char *message, sexp obj) { res = sexp_make_exception(ctx, sym = sexp_intern(ctx, "type"), str = sexp_c_string(ctx, message, -1), irr = sexp_list1(ctx, obj), - SEXP_FALSE, SEXP_FALSE, SEXP_FALSE); + SEXP_FALSE, SEXP_FALSE); sexp_gc_release(ctx, sym, s_sym); return res; } @@ -159,7 +158,7 @@ sexp sexp_range_exception (sexp ctx, sexp obj, sexp start, sexp end) { res = sexp_list2(ctx, start, end); res = sexp_cons(ctx, obj, res); res = sexp_make_exception(ctx, sexp_intern(ctx, "range"), msg, res, - SEXP_FALSE, SEXP_FALSE, SEXP_FALSE); + SEXP_FALSE, SEXP_FALSE); sexp_gc_release(ctx, res, s_res); return res; } @@ -176,14 +175,16 @@ sexp sexp_print_exception (sexp ctx, sexp exn, sexp out) { sexp_write(ctx, ls, out); } } - if (sexp_integerp(sexp_exception_line(exn)) - && (sexp_exception_line(exn) > sexp_make_integer(0))) { - sexp_write_string(ctx, " on line ", out); - sexp_write(ctx, sexp_exception_line(exn), out); - } - if (sexp_stringp(sexp_exception_file(exn))) { - sexp_write_string(ctx, " of file ", out); - sexp_write_string(ctx, sexp_string_data(sexp_exception_file(exn)), out); + if (sexp_pairp(sexp_exception_source(exn))) { + if (sexp_integerp(sexp_cdr(sexp_exception_source(exn))) + && (sexp_cdr(sexp_exception_source(exn)) >= sexp_make_integer(0))) { + sexp_write_string(ctx, " on line ", out); + sexp_write(ctx, sexp_cdr(sexp_exception_source(exn)), out); + } + if (sexp_stringp(sexp_car(sexp_exception_source(exn)))) { + sexp_write_string(ctx, " of file ", out); + sexp_write_string(ctx, sexp_string_data(sexp_car(sexp_exception_source(exn))), out); + } } sexp_write_string(ctx, ": ", out); sexp_write_string(ctx, sexp_string_data(sexp_exception_message(exn)), out); @@ -221,16 +222,18 @@ static sexp sexp_read_error (sexp ctx, char *msg, sexp irritants, sexp port) { sexp_gc_var(ctx, name, s_name); sexp_gc_var(ctx, str, s_str); sexp_gc_var(ctx, irr, s_irr); + sexp_gc_var(ctx, src, s_src); sexp_gc_preserve(ctx, name, s_name); sexp_gc_preserve(ctx, str, s_str); sexp_gc_preserve(ctx, irr, s_irr); + sexp_gc_preserve(ctx, src, s_src); name = (sexp_port_name(port) ? sexp_port_name(port) : SEXP_FALSE); + name = sexp_cons(ctx, name, sexp_make_integer(sexp_port_line(port))); str = sexp_c_string(ctx, msg, -1); irr = ((sexp_pairp(irritants) || sexp_nullp(irritants)) ? irritants : sexp_list1(ctx, irritants)); res = sexp_make_exception(ctx, the_read_error_symbol, - str, irr, SEXP_FALSE, name, - sexp_make_integer(sexp_port_line(port))); + str, irr, SEXP_FALSE, name); sexp_gc_release(ctx, name, s_name); return res; } @@ -241,6 +244,7 @@ sexp sexp_cons (sexp ctx, sexp head, sexp tail) { sexp pair = sexp_alloc_type(ctx, pair, SEXP_PAIR); sexp_car(pair) = head; sexp_cdr(pair) = tail; + sexp_pair_source(pair) = SEXP_FALSE; return pair; } @@ -765,9 +769,10 @@ sexp sexp_make_input_port (sexp ctx, FILE* in, sexp name) { sexp p = sexp_alloc_type(ctx, port, SEXP_IPORT); sexp_port_stream(p) = in; sexp_port_name(p) = name; - sexp_port_line(p) = 0; + sexp_port_line(p) = 1; sexp_port_buf(p) = NULL; sexp_port_openp(p) = 1; + sexp_port_sourcep(p) = 1; sexp_port_cookie(p) = SEXP_VOID; return p; } @@ -1066,7 +1071,7 @@ sexp sexp_read_number(sexp ctx, sexp in, int base) { sexp sexp_read_raw (sexp ctx, sexp in) { char *str; - int c1, c2; + int c1, c2, line; sexp tmp2; sexp_gc_var(ctx, res, s_res); sexp_gc_var(ctx, tmp, s_tmp); @@ -1113,6 +1118,7 @@ sexp sexp_read_raw (sexp ctx, sexp in) { res = sexp_read_string(ctx, in); break; case '(': + line = (sexp_port_sourcep(in) ? sexp_port_line(in) : -1); res = SEXP_NULL; tmp = sexp_read_raw(ctx, in); while ((tmp != SEXP_EOF) && (tmp != SEXP_CLOSE) && (tmp != SEXP_RAWDOT)) { @@ -1150,6 +1156,9 @@ sexp sexp_read_raw (sexp ctx, sexp in) { res = sexp_read_error(ctx, "missing trailing ')'", SEXP_NULL, in); } } + if ((line >= 0) && sexp_pairp(res)) + sexp_pair_source(res) + = sexp_cons(ctx, sexp_port_name(in), sexp_make_integer(line)); break; case '#': switch (c1=sexp_read_char(ctx, in)) {