trace: implement redefinition checks.

The tracing module should warn when traced functions or
methods are being redefined, and stop tracing the original
methods.

* eval.c (trace_check): New function. Calls
sys:trace-redefined-check if the trace module has been
loaded, otherwise does nothing.
(op_defun, op_defmacro): Call trace_check to have a warning
issued for a redefined traced function or macro.

* eval.h (trace_check): Declared.

* lisplib.c (trace_loaded): New global variable.
(trace_instantiate): Flip trace_loaded to t.

* lisplib.h (trace_loaded): Declared.

* share/txr/stdlib/trace.tl (sys:trace-redefine-check): New
function. Checks two situations: traced function or method
is redefined (neither old nor new is traced any longer),
and traced method is overridden (base method continues to be
traced, override is not traced).

* struct.c (static_slot_ensure): Do a trace check here,
taking care of defmeth.

1 files changed, 15 insertions, 0 deletions

diff --git a/eval.c b/eval.c
index 873c810c..6f5d89c3 100644
--- a/eval.c
+++ b/eval.c
@@ -1775,6 +1775,17 @@ static val op_defsymacro(val form, val env)
 
 static val op_defmacro(val form, val env);
 
+void trace_check(val name)
+{
+  if (trace_loaded) {
+    val trcheck = lookup_fun(nil,
+                             intern(lit("trace-redefine-check"),
+                                    system_package));
+    if (trcheck)
+      funcall1(cdr(trcheck), name);
+  }
+}
+
 static val op_defun(val form, val env)
 {
   val args = rest(form);
@@ -1782,6 +1793,8 @@ static val op_defun(val form, val env)
   val params = second(args);
   val body = rest(rest(args));
 
+  trace_check(name);
+
   if (!consp(name)) {
     val block = cons(block_s, cons(name, body));
     val fun = cons(name, cons(params, cons(block, nil)));
@@ -1858,6 +1871,8 @@ static val op_defmacro(val form, val env)
   if (gethash(op_table, name))
     eval_error(form, lit("defmacro: ~s is a special operator"), name, nao);
 
+  trace_check(name);
+
   /* defmacro captures lexical environment, so env is passed */
   sethash(top_mb, name,
           rlcp_tree(cons(name, func_f2(cons(env, cons(params, cons(block, nil))),