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.

1 files changed, 30 insertions, 12 deletions

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;
 }