From 2c4d870ce98b425d07b136e12ba782cfc8e23367 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 10 Feb 2017 14:09:34 -0800
Subject: 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.
---
 unwind.c | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

(limited to 'unwind.c')

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),
-- 
cgit v1.2.3