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.

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;