Deferred warnings.

Warnings about undefined functions and variables are now
deferred during loading, so forward references do not generate
nuisance diagnostics.

* eval.c (load_recursive_s): New symbol variable.
(eval_defr_warn): New static function.
(op_defvarl, op_defun): Purge any deferred warning about the
given function or variable not being defined.
(load): Rebind the sys:*load-recursive* special var to true
around the load. After the load, dump deferred warnings
if the prior binding of sys:*load-recursive* is false.
Discard deferred warnings in the case of termination by
a nonlocal control transfer.
(do_expand): Treat unbound vars and functions as deferrable
warnings, specially tagged for individual purging frkm
the deferred list.
(eval_init): Intern sys:*load-recursive* and initialize
load_recursive_s variable.

* eval.h (load_recursive_s): Declared.

* parse.c (repl_warning): Accept variable arguments.
Check whether we are loading and if so, defer deferrable
(repl): Adjustment for altered signature of repl_warning.
warnings.

* txr.c (txr_main): dump deferred warnings after
evaluating Lisp stream.

* unwind.c (deferred_warnings): New static variable.
(uw_throw): When a deferrable warning is caught,
suppress the usual message and add it to the
deferred_warnings list.
(uw_defer_warning, uw_dump_deferred_warnings,
uw_dump_deferred_warnings, uw_purge_deferred_warnings): New
functions.
(uw_late_init): gc-protect deferred_warnings.

* unwind.h (uw_defer_warning, uw_dump_deferred_warnings,
uw_dump_deferred_warnings, uw_purge_deferred_warnings): New
functions declared.

1 files changed, 31 insertions, 2 deletions

diff --git a/unwind.c b/unwind.c
index 5a880acc..4c839735 100644
--- a/unwind.c
+++ b/unwind.c
@@ -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);