Not warning about undefs on an error is bad - modifying to warn for everything

except the irritants of the error, to avoid the duplicate warn+error undefined.
This commit is contained in:
Alex Shinn 2012-02-02 23:44:15 +09:00
parent af60e10c4f
commit 066d24c2d1
3 changed files with 14 additions and 16 deletions

12
eval.c
View file

@ -40,10 +40,11 @@ static void sexp_warn (sexp ctx, char *msg, sexp x) {
} }
} }
void sexp_warn_undefs (sexp ctx, sexp from, sexp to) { void sexp_warn_undefs (sexp ctx, sexp from, sexp to, sexp res) {
sexp x; sexp x, ignore = sexp_exceptionp(res) ? sexp_exception_irritants(res) : SEXP_NULL;
for (x=from; sexp_pairp(x) && x!=to; x=sexp_env_next_cell(x)) for (x=from; sexp_pairp(x) && x!=to; x=sexp_env_next_cell(x))
if (sexp_cdr(x) == SEXP_UNDEF) if (sexp_cdr(x) == SEXP_UNDEF && sexp_car(x) != ignore
&& sexp_not(sexp_memq(ctx, sexp_car(x), ignore)))
sexp_warn(ctx, "reference to undefined variable: ", sexp_car(x)); sexp_warn(ctx, "reference to undefined variable: ", sexp_car(x));
} }
@ -1148,8 +1149,8 @@ sexp sexp_load_op (sexp ctx, sexp self, sexp_sint_t n, sexp source, sexp env) {
sexp_gc_preserve4(ctx, ctx2, x, in, res); sexp_gc_preserve4(ctx, ctx2, x, in, res);
out = sexp_current_error_port(ctx); out = sexp_current_error_port(ctx);
ctx2 = sexp_make_eval_context(ctx, sexp_context_stack(ctx), env, 0, 0); ctx2 = sexp_make_eval_context(ctx, sexp_context_stack(ctx), env, 0, 0);
sexp_context_parent(ctx2) = ctx;
tmp = sexp_env_bindings(env); tmp = sexp_env_bindings(env);
sexp_context_parent(ctx2) = ctx;
sexp_context_tailp(ctx2) = 0; sexp_context_tailp(ctx2) = 0;
if (sexp_exceptionp(in)) { if (sexp_exceptionp(in)) {
if (sexp_not(out)) out = sexp_current_error_port(ctx); if (sexp_not(out)) out = sexp_current_error_port(ctx);
@ -1169,8 +1170,7 @@ sexp sexp_load_op (sexp ctx, sexp self, sexp_sint_t n, sexp source, sexp env) {
sexp_close_port(ctx, in); sexp_close_port(ctx, in);
} }
#if SEXP_USE_WARN_UNDEFS #if SEXP_USE_WARN_UNDEFS
if (! sexp_exceptionp(res)) sexp_warn_undefs(ctx, sexp_env_bindings(env), tmp, res);
sexp_warn_undefs(ctx, sexp_env_bindings(env), tmp);
#endif #endif
sexp_gc_release4(ctx); sexp_gc_release4(ctx);
#if SEXP_USE_DL || SEXP_USE_STATIC_LIBS #if SEXP_USE_DL || SEXP_USE_STATIC_LIBS

View file

@ -82,7 +82,7 @@ SEXP_API sexp sexp_env_define (sexp ctx, sexp env, sexp sym, sexp val);
SEXP_API sexp sexp_env_cell (sexp env, sexp sym, int localp); SEXP_API sexp sexp_env_cell (sexp env, sexp sym, int localp);
SEXP_API sexp sexp_env_ref (sexp env, sexp sym, sexp dflt); SEXP_API sexp sexp_env_ref (sexp env, sexp sym, sexp dflt);
SEXP_API sexp sexp_parameter_ref (sexp ctx, sexp param); SEXP_API sexp sexp_parameter_ref (sexp ctx, sexp param);
SEXP_API void sexp_warn_undefs (sexp ctx, sexp from, sexp to); SEXP_API void sexp_warn_undefs (sexp ctx, sexp from, sexp to, sexp res);
SEXP_API sexp sexp_make_lit (sexp ctx, sexp value); SEXP_API sexp sexp_make_lit (sexp ctx, sexp value);
SEXP_API sexp sexp_make_opcode (sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc1); SEXP_API sexp sexp_make_opcode (sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc1);
SEXP_API sexp sexp_make_procedure_op (sexp ctx, sexp self, sexp_sint_t n, sexp flags, sexp num_args, sexp bc, sexp vars); SEXP_API sexp sexp_make_procedure_op (sexp ctx, sexp self, sexp_sint_t n, sexp flags, sexp num_args, sexp bc, sexp vars);

16
main.c
View file

@ -197,22 +197,20 @@ static void repl (sexp ctx, sexp env) {
if (sexp_exceptionp(obj)) { if (sexp_exceptionp(obj)) {
sexp_print_exception(ctx, obj, err); sexp_print_exception(ctx, obj, err);
} else { } else {
tmp = sexp_env_bindings(env);
sexp_context_top(ctx) = 0; sexp_context_top(ctx) = 0;
if (!(sexp_idp(obj)||sexp_pairp(obj))) if (!(sexp_idp(obj)||sexp_pairp(obj)))
obj = sexp_make_lit(ctx, obj); obj = sexp_make_lit(ctx, obj);
tmp = sexp_env_bindings(env);
res = sexp_eval(ctx, obj, env); res = sexp_eval(ctx, obj, env);
#if SEXP_USE_WARN_UNDEFS
sexp_warn_undefs(ctx, sexp_env_bindings(env), tmp, res);
#endif
if (sexp_exceptionp(res)) { if (sexp_exceptionp(res)) {
sexp_print_exception(ctx, res, err); sexp_print_exception(ctx, res, err);
sexp_stack_trace(ctx, err); sexp_stack_trace(ctx, err);
} else { } else if (res != SEXP_VOID) {
#if SEXP_USE_WARN_UNDEFS sexp_write(ctx, res, out);
sexp_warn_undefs(ctx, sexp_env_bindings(env), tmp); sexp_write_char(ctx, '\n', out);
#endif
if (res != SEXP_VOID) {
sexp_write(ctx, res, out);
sexp_write_char(ctx, '\n', out);
}
} }
} }
} }