From a928f32d7f83e7cb0cbf7a7251d3edd5ca5487ce Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sun, 22 Jan 2017 06:12:24 -0800 Subject: Enable unbound warnings when expanding TXR code. With this change, Lisp expansion-time warnings are no longer suppressed during the parsing of the TXR pattern language. Embedded Lisp expressions can refer to TXR pattern variables, which generates spurious warnings that must be suppressed. Since TXR pattern variables are dynamically introduced in a very flexible way, it's hard to do an exact job of this. We take the crude approach that warnings are suppressed for all pattern variables that appear anywhere in the TXR code. To do that, we identify, at parse time, all directives which can bind new variables, and register those variables as if they were tentative global defs, purging all pending warnings for them. * match.c (binding_directive_table): New static hash table. (match_reg_var, match_reg_params, match_reg_elem): New functions. (match_reg_var_rec): New static function. (dir_tables_init): gc-protect binding_directive_table, and populate its entries. * match.h (into_k, named_k): Declared. (match_reg_var, match_reg_params, match_reg_elem): Declared. * parser.y (process_catch_exprs): New static function. (elem): Call match_reg_elem for each basic directive, to process the variables in that directive according to its operator symbol. Do this for each compound form elem and variable elem. Te horizontal @(define) eleme has its own grammar production here, and we handle its parameter list in that rule. (define_clause): Handle the parameters of a vertical @(define). It binds pattern variables, and so we must suppress unbound warnings for those. (catch_clauses_opt): Process the parameters bound by @(catch) clauses. (output_clause): Suppress warnings for the variables nominated by any :into or :named argument. (expand_repeat_rep_args): Suppress warnings for :counter variable, and for :vars variables. (parse_once): Remove the warning-muffling handler frame set up around the yyparse call. * txr.c (txr_main): Suppress warnings for TXR variables defined using -D syntax on the command line. Dump deferred warnings after parsing a .txr file. --- match.c | 68 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---- match.h | 5 ++++- parser.y | 42 +++++++++++++++++++++++++++------------ txr.c | 4 ++++ 4 files changed, 102 insertions(+), 17 deletions(-) diff --git a/match.c b/match.c index d3c780ee..6ad9ac6a 100644 --- a/match.c +++ b/match.c @@ -71,7 +71,7 @@ val filter_s; val noval_s; static val h_directive_table, v_directive_table; -static val non_matching_directive_table; +static val non_matching_directive_table, binding_directive_table; static void debuglf(val form, val fmt, ...) { @@ -4401,6 +4401,55 @@ val extract(val spec, val files, val predefined_bindings) return result; } +void match_reg_var(val sym) +{ + if (bindable(sym) && !uw_tentative_def_exists(sym)) { + val tag = cons(var_s, sym); + uw_purge_deferred_warning(tag); + uw_register_tentative_def(tag); + } +} + +static void match_reg_var_rec(val sym) +{ + if (consp(sym)) { + match_reg_var_rec(car(sym)); + match_reg_var_rec(cdr(sym)); + return; + } + match_reg_var(sym); +} + +void match_reg_params(val params) +{ + for (; params; params = cdr(params)) { + val var = car(params); + if (atom(var)) + match_reg_var(var); + else + match_reg_var(car(var)); + } +} + +void match_reg_elem(val elem) +{ + if (consp(elem)) { + val sym = car(elem); + val vpos = gethash(binding_directive_table, sym); + if (vpos) { + val var = ref(elem, vpos); + match_reg_var_rec(var); + } else if (!gethash(h_directive_table, sym) && + !gethash(v_directive_table, sym)) + { + elem = cdr(elem); + for (; consp(elem); elem = cdr(elem)) + match_reg_var(car(elem)); + match_reg_var(elem); + } + } +} + static void syms_init(void) { decline_k = intern(lit("decline"), keyword_package); @@ -4452,12 +4501,14 @@ static void syms_init(void) static void dir_tables_init(void) { + protect(&h_directive_table, &v_directive_table, + &non_matching_directive_table, &binding_directive_table, + convert(val *, 0)); + h_directive_table = make_hash(nil, nil, nil); v_directive_table = make_hash(nil, nil, nil); non_matching_directive_table = make_hash(nil, nil, nil); - - protect(&h_directive_table, &v_directive_table, - &non_matching_directive_table, convert(val *, 0)); + binding_directive_table = make_hash(nil, nil, nil); sethash(v_directive_table, skip_s, cptr(coerce(mem_t *, v_skip))); sethash(v_directive_table, fuzz_s, cptr(coerce(mem_t *, v_fuzz))); @@ -4558,6 +4609,15 @@ static void dir_tables_init(void) sethash(non_matching_directive_table, do_s, t); sethash(non_matching_directive_table, load_s, t); sethash(non_matching_directive_table, close_s, t); + + sethash(binding_directive_table, var_s, one); + sethash(binding_directive_table, merge_s, one); + sethash(binding_directive_table, bind_s, one); + sethash(binding_directive_table, rebind_s, one); + sethash(binding_directive_table, line_s, one); + sethash(binding_directive_table, chr_s, one); + sethash(binding_directive_table, data_s, one); + sethash(binding_directive_table, name_s, one); } void match_init(void) diff --git a/match.h b/match.h index a3b19f0f..eb369495 100644 --- a/match.h +++ b/match.h @@ -27,11 +27,14 @@ extern val text_s, choose_s, gather_s, do_s, require_s; extern val close_s, load_s, include_s, mod_s, modlast_s, line_s; -extern val counter_k, vars_k, env_k, var_k; +extern val counter_k, vars_k, env_k, var_k, into_k, named_k; val match_expand_keyword_args(val elem); val match_expand_elem(val elem); val match_filter(val name, val arg, val other_args); val match_fun(val name, val args, val input, val files); val include(val specline); val extract(val spec, val filenames, val bindings); +void match_reg_var(val sym); +void match_reg_params(val params); +void match_reg_elem(val elem); void match_init(void); diff --git a/parser.y b/parser.y index 9fbdbf99..73b9ce1f 100644 --- a/parser.y +++ b/parser.y @@ -59,6 +59,7 @@ static val sym_helper(parser_t *parser, wchar_t *lexeme, val meta_allowed); static val repeat_rep_helper(val sym, val args, val main, val parts); +static void process_catch_exprs(val exprs); static val define_transform(parser_t *parser, val define_form); static val lit_char_helper(val litchars); static val optimize_text(val text_form); @@ -452,14 +453,16 @@ texts : text %prec LOW { $$ = rlcp(cons($1, nil), $1); } elem : texts { $$ = rlcp(cons(text_s, $1), $1); $$ = rlcp(optimize_text($$), $$); } - | var { $$ = rl($1, num(parser->lineno)); } + | var { $$ = rl($1, num(parser->lineno)); + match_reg_elem($$); } | list { val sym = first($1); if (sym == do_s || sym == require_s) $$ = rlcp(cons(sym, expand_forms(rest($1), nil)), $1); else - $$ = match_expand_elem($1); } + { $$ = match_expand_elem($1); + match_reg_elem($$); } } | COLL exprs_opt ')' elems_opt END { val args = match_expand_keyword_args($2); $$ = list(coll_s, $4, nil, args, nao); rl($$, num($1)); } @@ -498,7 +501,8 @@ elem : texts { $$ = rlcp(cons(text_s, $1), $1); rl($$, num($1)); } | DEFINE exprs ')' elems END { $$ = list(define_s, t, $4, $2, nao); - rl($$, num($1)); } + rl($$, num($1)); + match_reg_params($2); } ; clause_parts_h : elems_opt additional_parts_h { $$ = if2($1, cons($1, $2)); } @@ -512,7 +516,8 @@ additional_parts_h : END { $$ = nil; } define_clause : DEFINE exprs ')' newl clauses_opt END newl { $$ = list(define_s, $2, $5, nao); - rl($$, num($1)); } + rl($$, num($1)); + match_reg_params($2); } | DEFINE ')' newl clauses_opt END newl { $$ = list(define_s, nil, $4, nao); @@ -548,6 +553,7 @@ catch_clauses_opt : CATCH ')' newl clauses_opt catch_clauses_opt { $$ = cons(list(catch_s, $2, $5, nao), $6); + process_catch_exprs($2); rl($$, num($1)); } | FINALLY newl clauses_opt { $$ = cons(list(finally_s, nil, @@ -583,8 +589,11 @@ output_clause : OUTPUT ')' o_elems '\n' val args = if3(dest_ex == dest, $2, cons(dest_ex, rest)); $$ = list(output_s, $5, args, nao); - rl($$, num($1)); } - + rl($$, num($1)); + { val into_var = second(memql(into_k, args)); + val named_var = second(memql(named_k, args)); + match_reg_var(into_var); + match_reg_var(named_var); } } | OUTPUT exprs ')' o_elems '\n' out_clauses END newl { $$ = nil; @@ -1287,6 +1296,7 @@ static val expand_repeat_rep_args(val args) ptail = list_collect(ptail, list(first(arg), expand(second(arg), nil), nao)); + match_reg_var(first(arg)); } else { ptail = list_collect(ptail, arg); } @@ -1300,6 +1310,8 @@ static val expand_repeat_rep_args(val args) ptail = list_collect(ptail, arg); continue; } + } else if (exp_pair) { + match_reg_var(arg); } exp_pair = exp_pairs = nil; @@ -1361,6 +1373,18 @@ static val repeat_rep_helper(val sym, val args, val main, val parts) nreverse(modlast_parts), nao); } +static void process_catch_exprs(val exprs) +{ + val params = rest(exprs); + for (; params; params = cdr(params)) { + val param = first(params); + if (consp(param)) + match_reg_var(car(param)); + else + match_reg_var(param); + } +} + static val define_transform(parser_t *parser, val define_form) { scanner_t *scnr = parser->scanner; @@ -1697,7 +1721,6 @@ void yybadtoken(parser_t *parser, int tok, val context) int parse_once(val stream, val name, parser_t *parser) { int res = 0; - uw_frame_t uw_handler; #if CONFIG_DEBUG_SUPPORT debug_state_t ds = debug_set_state(opt_dbg_expansion ? 0 : -1, opt_dbg_expansion); @@ -1708,9 +1731,6 @@ int parse_once(val stream, val name, parser_t *parser) parser->stream = stream; parser->name = name; - uw_push_handler(&uw_handler, cons(warning_s, nil), - func_n1v(uw_muffle_warning)); - uw_catch_begin(cons(error_s, nil), esym, eobj); res = yyparse(parser->scanner, parser); @@ -1731,8 +1751,6 @@ int parse_once(val stream, val name, parser_t *parser) uw_catch_end; - uw_pop_frame(&uw_handler); - return res; } diff --git a/txr.c b/txr.c index cc5fe87a..50022f15 100644 --- a/txr.c +++ b/txr.c @@ -591,6 +591,8 @@ int txr_main(int argc, char **argv) else bindings = cons(cons(sym, t), bindings); + match_reg_var(sym); + continue; } @@ -976,6 +978,8 @@ int txr_main(int argc, char **argv) close_stream(parse_stream, nil); + uw_dump_deferred_warnings(std_error); + if (parser.errors) return EXIT_FAILURE; -- cgit v1.2.3