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

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

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

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) {
sexp x;
void sexp_warn_undefs (sexp ctx, sexp from, sexp to, sexp res) {
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))
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));
}
@ -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);
out = sexp_current_error_port(ctx);
ctx2 = sexp_make_eval_context(ctx, sexp_context_stack(ctx), env, 0, 0);
sexp_context_parent(ctx2) = ctx;
tmp = sexp_env_bindings(env);
sexp_context_parent(ctx2) = ctx;
sexp_context_tailp(ctx2) = 0;
if (sexp_exceptionp(in)) {
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);
}
#if SEXP_USE_WARN_UNDEFS
if (! sexp_exceptionp(res))
sexp_warn_undefs(ctx, sexp_env_bindings(env), tmp);
sexp_warn_undefs(ctx, sexp_env_bindings(env), tmp, res);
#endif
sexp_gc_release4(ctx);
#if SEXP_USE_DL || SEXP_USE_STATIC_LIBS

2
include/chibi/eval.h
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_ref (sexp env, sexp sym, sexp dflt);
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_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);

12
main.c
View file

@ -197,25 +197,23 @@ static void repl (sexp ctx, sexp env) {
if (sexp_exceptionp(obj)) {
sexp_print_exception(ctx, obj, err);
} else {
tmp = sexp_env_bindings(env);
sexp_context_top(ctx) = 0;
if (!(sexp_idp(obj)||sexp_pairp(obj)))
obj = sexp_make_lit(ctx, obj);
tmp = sexp_env_bindings(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)) {
sexp_print_exception(ctx, res, err);
sexp_stack_trace(ctx, err);
} else {
#if SEXP_USE_WARN_UNDEFS
sexp_warn_undefs(ctx, sexp_env_bindings(env), tmp);
#endif
if (res != SEXP_VOID) {
} else if (res != SEXP_VOID) {
sexp_write(ctx, res, out);
sexp_write_char(ctx, '\n', out);
}
}
}
}
sexp_gc_release6(ctx);
}