From 2c4d870ce98b425d07b136e12ba782cfc8e23367 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku 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. --- eval.c | 6 +++--- parser.c | 2 +- txr.1 | 21 +++++++++++++++++---- txr.c | 4 ++-- unwind.c | 22 ++++++++++++++++++++++ unwind.h | 1 + 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); -- cgit v1.2.3