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

only warning when a non-procedure is found in an operator position

Browse source
This commit is contained in:
Alex Shinn 2010-05-15 14:42:19 +09:00
parent 102b946b9d
commit aaf3f84c22
3 changed files with 31 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

52
eval.c
View file

@ -41,6 +41,24 @@ sexp sexp_compile_error (sexp ctx, const char *message, sexp o) {
return exn;
}
static void sexp_warn (sexp ctx, char *msg, sexp x) {
sexp out = sexp_current_error_port(ctx);
if (sexp_oportp(out)) {
sexp_write_string(ctx, "WARNING: ", out);
sexp_write_string(ctx, msg, out);
sexp_write(ctx, x, out);
sexp_write_char(ctx, '\n', out);
}
}
void sexp_warn_undefs (sexp ctx, sexp from, sexp to) {
sexp x;
for (x=from; sexp_pairp(x) && x!=to; x=sexp_cdr(x))
if (sexp_cdar(x) == SEXP_UNDEF)
sexp_warn(ctx, "reference to undefined variable", sexp_caar(x));
}
/********************** environment utilities ***************************/
static sexp sexp_env_cell_loc (sexp env, sexp key, sexp *varenv) {
@ -768,13 +786,13 @@ static sexp analyze (sexp ctx, sexp object) {
res = analyze_app(ctx, x);
}
}
} else if (sexp_truep(sexp_listp(ctx, sexp_car(x)))
|| (sexp_synclop(sexp_car(x))
&& sexp_truep(sexp_listp(ctx,
sexp_synclo_expr(sexp_car(x)))))) {
res = analyze_app(ctx, x);
} else {
res = sexp_compile_error(ctx, "invalid operand in application", x);
if (! (sexp_truep(sexp_listp(ctx, sexp_car(x)))
|| (sexp_synclop(sexp_car(x))
&& sexp_truep(sexp_listp(ctx,
sexp_synclo_expr(sexp_car(x)))))))
sexp_warn(ctx, "invalid operand in application: ", x);
res = analyze_app(ctx, x);
}
} else if (sexp_idp(x)) {
res = analyze_var_ref(ctx, x, NULL);
@ -898,16 +916,6 @@ static sexp sexp_close_port_op (sexp ctx sexp_api_params(self, n), sexp port) {
return sexp_finalize_port(ctx sexp_api_pass(self, n), port);
}
void sexp_warn_undefs (sexp ctx, sexp from, sexp to, sexp out) {
sexp x;
for (x=from; sexp_pairp(x) && x!=to; x=sexp_cdr(x))
if (sexp_cdar(x) == SEXP_UNDEF) {
sexp_write_string(ctx, "WARNING: reference to undefined variable: ", out);
sexp_write(ctx, sexp_caar(x), out);
sexp_write_char(ctx, '\n', out);
}
}
#if SEXP_USE_DL
#ifdef __MINGW32__
#include <windows.h>
@ -983,8 +991,8 @@ sexp sexp_load_op (sexp ctx sexp_api_params(self, n), sexp source, sexp env) {
}
#endif
#if SEXP_USE_WARN_UNDEFS
if (sexp_oportp(out) && ! sexp_exceptionp(res))
sexp_warn_undefs(ctx, sexp_env_bindings(env), tmp, out);
if (! sexp_exceptionp(res))
sexp_warn_undefs(ctx, sexp_env_bindings(env), tmp);
#endif
return res;
}
@ -1472,7 +1480,7 @@ sexp sexp_make_standard_env_op (sexp ctx sexp_api_params(self, n), sexp version)
}
sexp sexp_env_copy_op (sexp ctx sexp_api_params(self, n), sexp to, sexp from, sexp ls, sexp immutp) {
sexp oldname, newname, value, out;
sexp oldname, newname, value;
if (! sexp_envp(to)) to = sexp_context_env(ctx);
if (! sexp_envp(from)) from = sexp_context_env(ctx);
if (sexp_not(ls)) {
@ -1497,10 +1505,8 @@ sexp sexp_env_copy_op (sexp ctx sexp_api_params(self, n), sexp to, sexp from, se
if (value != SEXP_UNDEF) {
sexp_env_define(ctx, to, newname, value);
#if SEXP_USE_WARN_UNDEFS
} else if (sexp_oportp(out=sexp_current_error_port(ctx))) {
sexp_write_string(ctx, "WARNING: importing undefined variable: ", out);
sexp_write(ctx, oldname, out);
sexp_write_char(ctx, '\n', out);
} else {
sexp_warn(ctx, "importing undefined variable: ", oldname);
#endif
}
}

2
include/chibi/eval.h
View file

@ -149,7 +149,7 @@ SEXP_API sexp sexp_env_define (sexp context, sexp env, sexp sym, sexp val);
SEXP_API sexp sexp_env_cell (sexp env, sexp sym);
SEXP_API sexp sexp_env_ref (sexp env, sexp sym, sexp dflt);
SEXP_API sexp sexp_env_global_ref (sexp env, sexp sym, sexp dflt);
SEXP_API void sexp_warn_undefs (sexp ctx, sexp from, sexp to, sexp out);
SEXP_API void sexp_warn_undefs (sexp ctx, sexp from, sexp to);
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_api_params(self, n), sexp flags, sexp num_args, sexp bc, sexp vars);
SEXP_API sexp sexp_make_foreign (sexp ctx, const char *name, int num_args, int flags, sexp_proc1 f, sexp data);

2
main.c
View file

@ -47,7 +47,7 @@ static void repl (sexp ctx) {
sexp_print_exception(ctx, res, err);
} else {
#if SEXP_USE_WARN_UNDEFS
sexp_warn_undefs(ctx, sexp_env_bindings(env), tmp, err);
sexp_warn_undefs(ctx, sexp_env_bindings(env), tmp);
#endif
if (res != SEXP_VOID) {
sexp_write(ctx, res, out);