Better way for releasing deferred warnings.

We should be re-throwing deferred warnings as ordinary
warnings, not dumping them to a stream.

* eval.c (eval_exception): Use uw_release_deferred_warnings
instead of uw_dupm_deferred_warnings.
(load): Likewise.

* parser.c (read_eval_ret_last): Likewise.

* txr.c (txr_main): Likewise.

* unwind.c (uw_release_deferred_warnings): New function.

* unwind.h (uw_release_deferred_warnings): Declared.

* txr.1: Documented release-deferred-warnings and updated
documentation for dump-deferred-warnings.

6 files changed, 46 insertions, 10 deletions

diff --git a/eval.c b/eval.c
index ecd27f42..afd254dd 100644
--- a/eval.c
+++ b/eval.c
@@ -225,7 +225,7 @@ noreturn static void eval_exception(val sym, val ctx, val fmt, va_list vl)
 
   (void) vformat(stream, fmt, vl);
 
-  uw_dump_deferred_warnings(std_error);
+  uw_release_deferred_warnings();
 
   uw_throw(sym, get_string_from_stream(stream));
 }
@@ -1330,7 +1330,7 @@ val eval_intrinsic(val form, val env)
   val form_ex = (last_form_expanded = last_form_evaled = nil,
                  expand(form, nil));
   val loading = cdr(lookup_var(dyn_env, load_recursive_s));
-  val ret = ((void) (loading || uw_dump_deferred_warnings(std_error)),
+  val ret = ((void) (loading || uw_release_deferred_warnings()),
              eval(form_ex, default_bool_arg(env), form));
   last_form_expanded = lfx_save;
   last_form_evaled = lfe_save;
@@ -3858,7 +3858,7 @@ val load(val target)
   dyn_env = saved_dyn_env;
 
   if (!rec)
-    uw_dump_deferred_warnings(std_error);
+    uw_release_deferred_warnings();
 
   uw_unwind {
     close_stream(stream, nil);
diff --git a/parser.c b/parser.c
index a192cf82..a419ace6 100644
--- a/parser.c
+++ b/parser.c
@@ -896,7 +896,7 @@ static val read_eval_ret_last(val env, val counter,
   dyn_env = saved_dyn_env;
 
   if (!loading)
-    uw_dump_deferred_warnings(out_stream);
+    uw_release_deferred_warnings();
 
   prinl(value, out_stream);
   return t;
diff --git a/txr.1 b/txr.1
index 6c7a5b25..ff1b8e7d 100644
--- a/txr.1
+++ b/txr.1
@@ -34199,6 +34199,19 @@ deferrable warnings, and prints ordinary warnings:
       (throw 'continue))) ;; warning processed: resume execution
 .cble
 
+.coNP Function @ release-deferred-warnings
+.synb
+.mets (release-deferred-warnings)
+.syne
+.desc
+The
+.code release-deferred-warnings
+removes all warnings from the deferred list.
+Then, it issues each deferred warning as an ordinary warning.
+
+Note: there is normally no need for user programs to use this
+function since deferred warnings are issued automatically.
+
 .coNP Function @ dump-deferred-warnings
 .synb
 .mets (dump-deferred-warning << stream )
@@ -34206,15 +34219,15 @@ deferrable warnings, and prints ordinary warnings:
 .desc
 The
 .code dump-deferred-warnings
-converts the list of pending warnings into diagnostic messages
+empties the list of deferred warnings, and converts each one
+into a diagnostic message sent to
 sent to
 .metn stream .
-After the diagnostics are issued, the list of pending warnings
+After the diagnostics are printed, the list of pending warnings
 is cleared.
 
 Note: there is normally no need for user programs to use this
-function since deferred warnings are printed in various necessary
-circumstances.
+function since deferred warnings are issued automatically.
 
 .SS* Delimited Continuations
 
diff --git a/txr.c b/txr.c
index 2c96d34f..b15d275a 100644
--- a/txr.c
+++ b/txr.c
@@ -978,7 +978,7 @@ int txr_main(int argc, char **argv)
 
     close_stream(parse_stream, nil);
 
-    uw_dump_deferred_warnings(std_error);
+    uw_release_deferred_warnings();
 
     if (parser.errors)
       return EXIT_FAILURE;
@@ -1019,7 +1019,7 @@ int txr_main(int argc, char **argv)
 
     close_stream(parse_stream, nil);
 
-    uw_dump_deferred_warnings(std_error);
+    uw_release_deferred_warnings();
 
     if (!enter_repl)
       return result ? 0 : EXIT_FAILURE;
diff --git a/unwind.c b/unwind.c
index e3f661ca..d3697456 100644
--- a/unwind.c
+++ b/unwind.c
@@ -45,6 +45,7 @@
 #include "signal.h"
 #include "eval.h"
 #include "struct.h"
+#include "cadr.h"
 #include ALLOCA_H
 #include "unwind.h"
 
@@ -714,6 +715,26 @@ val uw_dump_deferred_warnings(val stream)
   return nil;
 }
 
+val uw_release_deferred_warnings(void)
+{
+  val wl = nreverse(zap(&deferred_warnings));
+
+  for (; wl; wl = cdr(wl)) {
+
+    uw_catch_begin (cons(continue_s, nil), exsym, exvals);
+
+    uw_throw(warning_s, caar(wl));
+
+    uw_catch(exsym, exvals) { (void) exsym; (void) exvals; }
+
+    uw_unwind;
+
+    uw_catch_end;
+  }
+
+  return nil;
+}
+
 val uw_purge_deferred_warning(val tag)
 {
   deferred_warnings = remqual(tag, deferred_warnings, cdr_f);
@@ -1051,6 +1072,7 @@ void uw_late_init(void)
   reg_fun(intern(lit("tentative-def-exists"), user_package), func_n1(uw_tentative_def_exists));
   reg_fun(intern(lit("defer-warning"), user_package), func_n1(uw_defer_warning));
   reg_fun(intern(lit("dump-deferred-warnings"), user_package), func_n1(uw_dump_deferred_warnings));
+  reg_fun(intern(lit("release-deferred-warnings"), user_package), func_n0(uw_release_deferred_warnings));
   reg_fun(intern(lit("register-exception-subtypes"), user_package),
           func_n0v(register_exception_subtypes));
   reg_fun(intern(lit("exception-subtype-p"), user_package),
diff --git a/unwind.h b/unwind.h
index 30da0146..aeac00d6 100644
--- a/unwind.h
+++ b/unwind.h
@@ -130,6 +130,7 @@ noreturn val uw_errorf(val fmt, ...);
 noreturn val uw_errorfv(val fmt, struct args *args);
 val uw_defer_warning(val args);
 val uw_dump_deferred_warnings(val stream);
+val uw_release_deferred_warnings(void);
 val uw_purge_deferred_warning(val tag);
 val uw_register_tentative_def(val tag);
 val uw_tentative_def_exists(val tag);