diff options
| -rw-r--r-- | eval.c | 66 | ||||
| -rw-r--r-- | eval.h | 2 | ||||
| -rw-r--r-- | parser.c | 14 | ||||
| -rw-r--r-- | txr.c | 2 | ||||
| -rw-r--r-- | unwind.c | 33 | ||||
| -rw-r--r-- | unwind.h | 3 |
6 files changed, 106 insertions, 14 deletions
@@ -100,7 +100,7 @@ val macro_time_s, with_dyn_rebinds_s, macrolet_s; val defsymacro_s, symacrolet_s, prof_s, switch_s; val fbind_s, lbind_s, flet_s, labels_s; val opip_s, oand_s, chain_s, chand_s; -val load_path_s, sys_lisp1_value_s; +val load_path_s, load_recursive_s, sys_lisp1_value_s; val special_s, unbound_s; val whole_k, form_k, symacro_k; @@ -256,6 +256,40 @@ static val eval_warn(val ctx, val fmt, ...) return nil; } +static val eval_defr_warn(val ctx, val tag, val fmt, ...) +{ + uses_or2; + va_list vl; + + va_start (vl, fmt); + + uw_catch_begin (cons(continue_s, nil), exsym, exvals); + + { + val form = ctx_form(ctx); + val stream = make_string_output_stream(); + val loc = or2(source_loc_str(form, nil), + source_loc_str(last_form_evaled, nil)); + + if (loc) + format(stream, lit("(~a) "), loc, nao); + + (void) vformat(stream, fmt, vl); + + uw_throw(warning_s, cons(get_string_from_stream(stream), tag)); + } + + uw_catch(exsym, exvals) { (void) exsym; (void) exvals; } + + uw_unwind; + + uw_catch_end; + + va_end (vl); + + return nil; +} + val lookup_origin(val form) { return gethash(origin_hash, form); @@ -1650,6 +1684,7 @@ static val op_defvarl(val form, val env) val value = eval(second(args), env, form); remhash(top_smb, sym); sethash(top_vb, sym, cons(sym, value)); + uw_purge_deferred_warning(cons(var_s, sym)); } return sym; @@ -1686,6 +1721,7 @@ static val op_defun(val form, val env) sethash(top_fb, name, cons(name, func_interp(env, fun))); if (eval_initing) sethash(builtin, name, defun_s); + uw_purge_deferred_warning(cons(fun_s, name)); return name; } else if (car(name) == meth_s) { val binding = lookup_fun(nil, intern(lit("defmeth"), system_package)); @@ -3630,6 +3666,7 @@ val load(val target) val name, stream; val txr_lisp_p = t; val saved_dyn_env = dyn_env; + val rec = cdr(lookup_var(saved_dyn_env, load_recursive_s)); open_txr_file(path, &txr_lisp_p, &name, &stream); @@ -3643,6 +3680,7 @@ val load(val target) dyn_env = make_env(nil, nil, dyn_env); env_vbind(dyn_env, load_path_s, path); + env_vbind(dyn_env, load_recursive_s, t); env_vbind(dyn_env, package_s, cur_package); if (!read_eval_stream(stream, std_error, nil)) { @@ -3652,8 +3690,13 @@ val load(val target) dyn_env = saved_dyn_env; + if (!rec) + uw_dump_deferred_warnings(std_error); + uw_unwind { close_stream(stream, nil); + if (!rec) + uw_dump_deferred_warnings(std_null); } uw_catch_end; @@ -3750,7 +3793,9 @@ static val do_expand(val form, val menv) return expand(rlcp_tree(symac, form), menv); } if (!lookup_var(menv, form)) - eval_warn(last_form_expanded, lit("unbound variable ~s"), form, nao); + eval_defr_warn(last_form_expanded, + cons(var_s, form), + lit("unbound variable ~s"), form, nao); return form; } else if (atom(form)) { return form; @@ -4035,12 +4080,16 @@ static val do_expand(val form, val menv) } if (form_ex == form && args_ex == args) { - if (!lookup_fun(menv, sym) && !special_operator_p(sym)) - eval_warn(last_form_expanded, - if3(bindable(sym_ex), - lit("unbound function ~s"), - lit("~s appears in operator position")), - sym, nao); + if (!lookup_fun(menv, sym) && !special_operator_p(sym)) { + if (!bindable(sym_ex)) + eval_warn(last_form_expanded, + lit("~s appears in operator position"), sym, nao); + else + eval_defr_warn(last_form_expanded, + cons(fun_s, sym), + lit("unbound function ~s"), + sym, nao); + } return form; } @@ -5139,6 +5188,7 @@ void eval_init(void) chain_s = intern(lit("chain"), user_package); chand_s = intern(lit("chand"), user_package); load_path_s = intern(lit("*load-path*"), user_package); + load_recursive_s = intern(lit("*load-recursive*"), system_package); sys_lisp1_value_s = intern(lit("lisp1-value"), system_package); qquote_init(); @@ -31,7 +31,7 @@ extern val eval_error_s, if_s, call_s; extern val eq_s, eql_s, equal_s; extern val car_s, cdr_s; extern val last_form_evaled, last_form_expanded; -extern val load_path_s; +extern val load_path_s, load_recursive_s; #define load_path (deref(lookup_var_l(nil, load_path_s))) @@ -45,6 +45,7 @@ #include "signal.h" #include "unwind.h" #include "gc.h" +#include "args.h" #include "utf8.h" #include "hash.h" #include "eval.h" @@ -906,9 +907,16 @@ static val get_home_path(void) return getenv_wrap(lit("HOME")); } -static val repl_warning(val out_stream, val exc, val arg) +static val repl_warning(val out_stream, val exc, struct args *rest) { - format(out_stream, lit("** warning: ~!~a\n"), arg, nao); + val args = args_get_list(rest); + val loading = cdr(lookup_var(dyn_env, load_recursive_s)); + + if (loading && cdr(args)) + uw_defer_warning(args); + else + format(out_stream, lit("** warning: ~!~a\n"), car(args), nao); + uw_throw(continue_s, nil); } @@ -936,7 +944,7 @@ val repl(val bindings, val in_stream, val out_stream) val hist_len_var = lookup_global_var(listener_hist_len_s); val multi_line_var = lookup_global_var(listener_multi_line_p_s); val sel_inclusive_var = lookup_global_var(listener_sel_inclusive_p_s); - val rw_f = func_f2(out_stream, repl_warning); + val rw_f = func_f1v(out_stream, repl_warning); for (; bindings; bindings = cdr(bindings)) { val binding = car(bindings); @@ -1012,6 +1012,8 @@ int txr_main(int argc, char **argv) close_stream(parse_stream, nil); + uw_dump_deferred_warnings(std_error); + if (!enter_repl) return result ? 0 : EXIT_FAILURE; } @@ -59,6 +59,8 @@ static val sys_cont_free_s, sys_capture_cont_s; static val frame_type, catch_frame_type, handle_frame_type; +static val deferred_warnings; + /* C99 inline instantiations. */ #if __STDC_VERSION__ >= 199901L val uw_block_return(val tag, val result); @@ -578,7 +580,10 @@ val uw_throw(val sym, val args) if (sym == warning_s) { --reentry_count; - format(std_error, lit("warning: ~a\n"), car(args), nao); + if (cdr(args)) + uw_defer_warning(args); + else + format(std_error, lit("warning: ~a\n"), car(args), nao); uw_throw(continue_s, nil); abort(); } @@ -669,6 +674,30 @@ val type_mismatch(val fmt, ...) abort(); } +val uw_defer_warning(val args) +{ + push(args, &deferred_warnings); + return nil; +} + +val uw_dump_deferred_warnings(val stream) +{ + val wl = nreverse(zap(&deferred_warnings)); + + for (; wl; wl = cdr(wl)) { + val args = car(wl); + format(stream, lit("warning: ~a\n"), car(args), nao); + } + + return nil; +} + +val uw_purge_deferred_warning(val tag) +{ + deferred_warnings = remqual(tag, deferred_warnings, cdr_f); + return nil; +} + val uw_register_subtype(val sub, val sup) { val t_entry = assoc(t, exception_subtypes); @@ -969,7 +998,7 @@ void uw_init(void) void uw_late_init(void) { protect(&frame_type, &catch_frame_type, &handle_frame_type, - convert(val *, 0)); + &deferred_warnings, convert(val *, 0)); types_s = intern(lit("types"), user_package); jump_s = intern(lit("jump"), user_package); sys_cont_s = intern(lit("cont"), system_package); @@ -128,6 +128,9 @@ noreturn val uw_throwf(val sym, val fmt, ...); noreturn val uw_throwfv(val sym, val fmt, struct args *); 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_purge_deferred_warning(val tag); val uw_register_subtype(val sub, val super); val uw_exception_subtype_p(val sub, val sup); void uw_continue(uw_frame_t *target); |