Expander warns about unbound variables.

* eval.c (eval_exception): New static function.
(eval_error): Reduced to wrapper around eval_exception.
(eval_warn): New function.
(me_op): Bind the rest symbol in a shadowing env to suppress
watnings about unbound rest.
(do_expand): Throw a warning when a bindable symbol is
traversed that has no binding.
(expand): Don't install atoms as last_form_expanded.

* lib.c (warning_s, restart_s, continue_s): New symbol
variables.
(obj_init): Initialize new symbol variables.

* lib.h (warning_s, restart_s, continue_s): Declared.

* lisplib.c (except_set_entries): New entries for
ignwarn and macro-time-ignwarn.

* parser.c (repl_warning): New static function.
(repl): Use repl_warning function as a handler for
warning exceptions: to print their message and then
continue by throwing a continue exception.

* parser.y (warning_continue): New static function.
(parse_once): Use warning_continue to ignore warnings.
In other words, we suppress warnings from Lisp that is
mixed into TXR pattern language code, because this
produces too many false positives.

* share/txr/stdlib/except.tl (ignwarn, macro-time-ignwarn):
New macros.

* share/txr/stdlib/place.tl (call-update-expander,
call-clobber-expander, call-delete-expander): Ignore warnings
around calls to sys:expand, because of some gensym-related
false positives (we expand code into which we inserted some
gensyms, without having inserted the constructs which
bind them.

* tests/011/macros-2.txr: Suppress unbound variable
warnings from a test case.

* tests/012/ifa.tl: Bind unbound x y variables in one
test case.

* tests/012/struct.tl: Suppress unbound variable
warnings in some test cases.

* uwind.c (uw_throw): If a warning is unhandled, then
print its message with a "warning" prefix and then
throw a continue exception.
(uw_register_subtype): Eliminate the check for sub
already being a subtype of sup. This allows us to
officially register new types against t.
(uw_late_init): Register continue exception type as a
subtype of the restart type.
Formally register warning type.

* txr.1: Documented ignwarn.

1 files changed, 36 insertions, 9 deletions

diff --git a/eval.c b/eval.c
index 51fcdb4b..e4ad8859 100644
--- a/eval.c
+++ b/eval.c
@@ -211,27 +211,50 @@ val ctx_name(val obj)
   return nil;
 }
 
-noreturn val eval_error(val ctx, val fmt, ...)
+noreturn static void eval_exception(val sym, val ctx, val fmt, va_list vl)
 {
   uses_or2;
-  va_list vl;
   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));
 
-  va_start (vl, fmt);
-
   if (loc)
     format(stream, lit("(~a) "), loc, nao);
 
   (void) vformat(stream, fmt, vl);
-  va_end (vl);
 
-  uw_throw(eval_error_s, get_string_from_stream(stream));
+  uw_throw(sym, get_string_from_stream(stream));
+}
+
+noreturn val eval_error(val ctx, val fmt, ...)
+{
+  va_list vl;
+  va_start (vl, fmt);
+  eval_exception(eval_error_s, ctx, fmt, vl);
+  va_end (vl);
   abort();
 }
 
+static val eval_warn(val ctx, val fmt, ...)
+{
+  va_list vl;
+
+  uw_catch_begin (cons(continue_s, nil), exsym, exvals);
+
+  va_start (vl, fmt);
+  eval_exception(warning_s, ctx, fmt, vl);
+  va_end (vl);
+
+  uw_catch(exsym, exvals) { (void) exsym; (void) exvals; }
+
+  uw_unwind;
+
+  uw_catch_end;
+
+  return nil;
+}
+
 val lookup_origin(val form)
 {
   return gethash(origin_hash, form);
@@ -3107,9 +3130,10 @@ static val supplement_op_syms(val ssyms, val max)
 static val me_op(val form, val menv)
 {
   cons_bind (sym, body, form);
+  val new_menv = make_var_shadowing_env(menv, cons(rest_s, nil));
   val body_ex = if3(sym == op_s,
-                    expand_forms_lisp1(body, menv),
-                    expand(body, menv));
+                    expand_forms_lisp1(body, new_menv),
+                    expand(body, new_menv));
   val rest_gensym = gensym(lit("rest-"));
   cons_bind (syms, body_trans, transform_op(body_ex, nil, rest_gensym));
   val ssyms = sort(syms, func_n2(lt), car_f);
@@ -3597,6 +3621,8 @@ static val do_expand(val form, val menv)
         return form;
       return expand(rlcp_tree(symac, form), menv);
     }
+    if (!lookup_var(menv, form))
+      eval_warn(last_form_expanded, lit("unbound variable ~s"), form, nao);
     return form;
   } else if (atom(form)) {
     return form;
@@ -3886,7 +3912,8 @@ val expand(val form, val menv)
   val ret = nil;
   val lfe_save = last_form_expanded;
 
-  last_form_expanded = form;
+  if (consp(form))
+    last_form_expanded = form;
   ret = do_expand(form, menv);
   last_form_expanded = lfe_save;