From 066d24c2d16443026f3d577e6a7c8b468de123a2 Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Thu, 2 Feb 2012 23:44:15 +0900
Subject: [PATCH] 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.

---
 eval.c               | 12 ++++++------
 include/chibi/eval.h |  2 +-
 main.c               | 16 +++++++---------
 3 files changed, 14 insertions(+), 16 deletions(-)

diff --git a/eval.c b/eval.c
index 2a6df2fb..a5ab8186 100644
--- a/eval.c
+++ b/eval.c
@@ -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
diff --git a/include/chibi/eval.h b/include/chibi/eval.h
index 5d0ce13a..14497a35 100644
--- a/include/chibi/eval.h
+++ b/include/chibi/eval.h
@@ -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);
diff --git a/main.c b/main.c
index 28ee8e3d..4d3fbe24 100644
--- a/main.c
+++ b/main.c
@@ -197,22 +197,20 @@ 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) {
-          sexp_write(ctx, res, out);
-          sexp_write_char(ctx, '\n', out);
-        }
+      } else if (res != SEXP_VOID) {
+        sexp_write(ctx, res, out);
+        sexp_write_char(ctx, '\n', out);
       }
     }
   }