Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 06:09:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

reporting source file and line number for compile-time errors

Browse source
This commit is contained in:
Alex Shinn 2009-06-28 14:52:52 +09:00
parent ab2cbe12f7
commit f1e7c3a2db
4 changed files with 53 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
eval.c
View file

@ -368,7 +368,8 @@ static sexp sexp_compile_error(sexp ctx, char *message, sexp obj) {
irritants = sexp_list1(ctx, obj); irritants = sexp_list1(ctx, obj);
msg = sexp_c_string(ctx, message, -1); msg = sexp_c_string(ctx, message, -1);
exn = sexp_make_exception(ctx, the_compile_error_symbol, msg, irritants, 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); sexp_gc_release(ctx, irritants, s_irr);
return exn; return exn;
} }
@ -558,7 +559,9 @@ static sexp analyze_define (sexp ctx, sexp x) {
res = sexp_compile_error(ctx, "bad define syntax", x); res = sexp_compile_error(ctx, "bad define syntax", x);
} else { } else {
name = (sexp_pairp(sexp_cadr(x)) ? sexp_caadr(x) : sexp_cadr(x)); 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)); tmp = sexp_cons(ctx, name, sexp_context_lambda(ctx));
sexp_push(ctx, sexp_env_bindings(env), tmp); sexp_push(ctx, sexp_env_bindings(env), tmp);
sexp_push(ctx, sexp_lambda_sv(sexp_env_lambda(env)), name); 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); sexp_print_exception(ctx, in, out);
res = in; res = in;
} else { } else {
sexp_port_sourcep(in) = 1;
while ((x=sexp_read(ctx, in)) != (sexp) SEXP_EOF) { while ((x=sexp_read(ctx, in)) != (sexp) SEXP_EOF) {
res = sexp_eval(ctx2, x); res = sexp_eval(ctx2, x);
if (sexp_exceptionp(res)) if (sexp_exceptionp(res))

13
include/chibi/sexp.h
View file

@ -114,6 +114,7 @@ struct sexp_struct {
} type; } type;
struct { struct {
sexp car, cdr; sexp car, cdr;
sexp source;
} pair; } pair;
struct { struct {
sexp_uint_t length; sexp_uint_t length;
@ -129,12 +130,12 @@ struct sexp_struct {
struct { struct {
FILE *stream; FILE *stream;
char *buf; char *buf;
sexp_uint_t offset, line, size, openp; sexp_uint_t offset, line, size, openp, sourcep;
sexp name; sexp name;
sexp cookie; sexp cookie;
} port; } port;
struct { struct {
sexp kind, message, irritants, procedure, file, line; sexp kind, message, irritants, procedure, source;
} exception; } exception;
struct { struct {
char sign; 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_name(p) ((p)->value.port.name)
#define sexp_port_line(p) ((p)->value.port.line) #define sexp_port_line(p) ((p)->value.port.line)
#define sexp_port_openp(p) ((p)->value.port.openp) #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_cookie(p) ((p)->value.port.cookie)
#define sexp_port_buf(p) ((p)->value.port.buf) #define sexp_port_buf(p) ((p)->value.port.buf)
#define sexp_port_size(p) ((p)->value.port.size) #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_message(p) ((p)->value.exception.message)
#define sexp_exception_irritants(p) ((p)->value.exception.irritants) #define sexp_exception_irritants(p) ((p)->value.exception.irritants)
#define sexp_exception_procedure(p) ((p)->value.exception.procedure) #define sexp_exception_procedure(p) ((p)->value.exception.procedure)
#define sexp_exception_file(p) ((p)->value.exception.file) #define sexp_exception_source(p) ((p)->value.exception.source)
#define sexp_exception_line(p) ((p)->value.exception.line)
#define sexp_bytecode_length(x) ((x)->value.bytecode.length) #define sexp_bytecode_length(x) ((x)->value.bytecode.length)
#define sexp_bytecode_name(x) ((x)->value.bytecode.name) #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_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_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_car(x) ((x)->value.pair.car)
#define sexp_cdr(x) ((x)->value.pair.cdr) #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_input_string_port(sexp ctx, sexp str);
sexp sexp_make_output_string_port(sexp ctx); sexp sexp_make_output_string_port(sexp ctx);
sexp sexp_get_output_string(sexp ctx, sexp port); 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_user_exception (sexp ctx, sexp self, char *message, sexp obj);
sexp sexp_type_exception (sexp ctx, 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); sexp sexp_range_exception (sexp ctx, sexp obj, sexp start, sexp end);

17
main.c
View file

@ -52,6 +52,7 @@ void repl (sexp ctx) {
in = sexp_eval_string(ctx, "(current-input-port)"); in = sexp_eval_string(ctx, "(current-input-port)");
out = sexp_eval_string(ctx, "(current-output-port)"); out = sexp_eval_string(ctx, "(current-output-port)");
err = sexp_eval_string(ctx, "(current-error-port)"); err = sexp_eval_string(ctx, "(current-error-port)");
sexp_port_sourcep(in) = 1;
while (1) { while (1) {
sexp_write_string(ctx, "> ", out); sexp_write_string(ctx, "> ", out);
sexp_flush(ctx, out); sexp_flush(ctx, out);
@ -98,6 +99,8 @@ void run_main (int argc, char **argv) {
res = sexp_eval(ctx, res); res = sexp_eval(ctx, res);
if (sexp_exceptionp(res)) { if (sexp_exceptionp(res)) {
sexp_print_exception(ctx, res, out); sexp_print_exception(ctx, res, out);
quit = 1;
break;
} else if (argv[i][1] == 'p') { } else if (argv[i][1] == 'p') {
sexp_write(ctx, res, out); sexp_write(ctx, res, out);
sexp_write_char(ctx, '\n', out); sexp_write_char(ctx, '\n', out);
@ -123,12 +126,14 @@ void run_main (int argc, char **argv) {
if (! quit) { if (! quit) {
if (! init_loaded) if (! init_loaded)
sexp_load(ctx, str=find_module_file(ctx, sexp_init_file), env); res = sexp_load(ctx, str=find_module_file(ctx, sexp_init_file), env);
if (i < argc) if (! sexp_exceptionp(res)) {
for ( ; i < argc; i++) if (i < argc)
sexp_load(ctx, str=sexp_c_string(ctx, argv[i], -1), env); for ( ; i < argc; i++)
else sexp_load(ctx, str=sexp_c_string(ctx, argv[i], -1), env);
repl(ctx); else
repl(ctx);
}
} }
sexp_gc_release(ctx, str, s_str); sexp_gc_release(ctx, str, s_str);

47
sexp.c
View file

@ -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_FIXNUM, 0, 0, 0, 0, 0, 0, 0, "fixnum"),
_DEF_TYPE(SEXP_CHAR, 0, 0, 0, 0, 0, 0, 0, "char"), _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_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_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_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"), _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 *****************************/ /***************************** exceptions *****************************/
sexp sexp_make_exception (sexp ctx, sexp kind, sexp message, sexp irritants, 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 exn = sexp_alloc_type(ctx, exception, SEXP_EXCEPTION);
sexp_exception_kind(exn) = kind; sexp_exception_kind(exn) = kind;
sexp_exception_message(exn) = message; sexp_exception_message(exn) = message;
sexp_exception_irritants(exn) = irritants; sexp_exception_irritants(exn) = irritants;
sexp_exception_procedure(exn) = procedure; sexp_exception_procedure(exn) = procedure;
sexp_exception_file(exn) = file; sexp_exception_source(exn) = source;
sexp_exception_line(exn) = line;
return exn; 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), str = sexp_c_string(ctx, message, -1),
((sexp_pairp(irritants) || sexp_nullp(irritants)) ((sexp_pairp(irritants) || sexp_nullp(irritants))
? irritants : (irr = sexp_list1(ctx, irritants))), ? irritants : (irr = sexp_list1(ctx, irritants))),
self, SEXP_FALSE, SEXP_FALSE); self, SEXP_FALSE);
sexp_gc_release(ctx, sym, s_sym); sexp_gc_release(ctx, sym, s_sym);
return res; 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"), res = sexp_make_exception(ctx, sym = sexp_intern(ctx, "type"),
str = sexp_c_string(ctx, message, -1), str = sexp_c_string(ctx, message, -1),
irr = sexp_list1(ctx, obj), irr = sexp_list1(ctx, obj),
SEXP_FALSE, SEXP_FALSE, SEXP_FALSE); SEXP_FALSE, SEXP_FALSE);
sexp_gc_release(ctx, sym, s_sym); sexp_gc_release(ctx, sym, s_sym);
return res; 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_list2(ctx, start, end);
res = sexp_cons(ctx, obj, res); res = sexp_cons(ctx, obj, res);
res = sexp_make_exception(ctx, sexp_intern(ctx, "range"), msg, 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); sexp_gc_release(ctx, res, s_res);
return res; return res;
} }
@ -176,14 +175,16 @@ sexp sexp_print_exception (sexp ctx, sexp exn, sexp out) {
sexp_write(ctx, ls, out); sexp_write(ctx, ls, out);
} }
} }
if (sexp_integerp(sexp_exception_line(exn)) if (sexp_pairp(sexp_exception_source(exn))) {
&& (sexp_exception_line(exn) > sexp_make_integer(0))) { if (sexp_integerp(sexp_cdr(sexp_exception_source(exn)))
sexp_write_string(ctx, " on line ", out); && (sexp_cdr(sexp_exception_source(exn)) >= sexp_make_integer(0))) {
sexp_write(ctx, sexp_exception_line(exn), out); sexp_write_string(ctx, " on line ", out);
} sexp_write(ctx, sexp_cdr(sexp_exception_source(exn)), out);
if (sexp_stringp(sexp_exception_file(exn))) { }
sexp_write_string(ctx, " of file ", out); if (sexp_stringp(sexp_car(sexp_exception_source(exn)))) {
sexp_write_string(ctx, sexp_string_data(sexp_exception_file(exn)), out); 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, ": ", out);
sexp_write_string(ctx, sexp_string_data(sexp_exception_message(exn)), 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, name, s_name);
sexp_gc_var(ctx, str, s_str); sexp_gc_var(ctx, str, s_str);
sexp_gc_var(ctx, irr, s_irr); 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, name, s_name);
sexp_gc_preserve(ctx, str, s_str); sexp_gc_preserve(ctx, str, s_str);
sexp_gc_preserve(ctx, irr, s_irr); 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_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); str = sexp_c_string(ctx, msg, -1);
irr = ((sexp_pairp(irritants) || sexp_nullp(irritants)) irr = ((sexp_pairp(irritants) || sexp_nullp(irritants))
? irritants : sexp_list1(ctx, irritants)); ? irritants : sexp_list1(ctx, irritants));
res = sexp_make_exception(ctx, the_read_error_symbol, res = sexp_make_exception(ctx, the_read_error_symbol,
str, irr, SEXP_FALSE, name, str, irr, SEXP_FALSE, name);
sexp_make_integer(sexp_port_line(port)));
sexp_gc_release(ctx, name, s_name); sexp_gc_release(ctx, name, s_name);
return res; 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 pair = sexp_alloc_type(ctx, pair, SEXP_PAIR);
sexp_car(pair) = head; sexp_car(pair) = head;
sexp_cdr(pair) = tail; sexp_cdr(pair) = tail;
sexp_pair_source(pair) = SEXP_FALSE;
return pair; 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 p = sexp_alloc_type(ctx, port, SEXP_IPORT);
sexp_port_stream(p) = in; sexp_port_stream(p) = in;
sexp_port_name(p) = name; sexp_port_name(p) = name;
sexp_port_line(p) = 0; sexp_port_line(p) = 1;
sexp_port_buf(p) = NULL; sexp_port_buf(p) = NULL;
sexp_port_openp(p) = 1; sexp_port_openp(p) = 1;
sexp_port_sourcep(p) = 1;
sexp_port_cookie(p) = SEXP_VOID; sexp_port_cookie(p) = SEXP_VOID;
return p; return p;
} }
@ -1066,7 +1071,7 @@ sexp sexp_read_number(sexp ctx, sexp in, int base) {
sexp sexp_read_raw (sexp ctx, sexp in) { sexp sexp_read_raw (sexp ctx, sexp in) {
char *str; char *str;
int c1, c2; int c1, c2, line;
sexp tmp2; sexp tmp2;
sexp_gc_var(ctx, res, s_res); sexp_gc_var(ctx, res, s_res);
sexp_gc_var(ctx, tmp, s_tmp); 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); res = sexp_read_string(ctx, in);
break; break;
case '(': case '(':
line = (sexp_port_sourcep(in) ? sexp_port_line(in) : -1);
res = SEXP_NULL; res = SEXP_NULL;
tmp = sexp_read_raw(ctx, in); tmp = sexp_read_raw(ctx, in);
while ((tmp != SEXP_EOF) && (tmp != SEXP_CLOSE) && (tmp != SEXP_RAWDOT)) { 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); 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; break;
case '#': case '#':
switch (c1=sexp_read_char(ctx, in)) { switch (c1=sexp_read_char(ctx, in)) {