Report chain of macro-expansions in errors.

* eval.c (origin_hash): New global variable.
(lookup_origin): New function.
(expand_macro): Enter original form into origin hash, keyed by
new form.
(eval_init): gc-protect and initialize origin_hash.

* eval.h (lookup_origin): Declared.

* parser.c (repl): Report chain of expansions from
last_form_evaled.

* unwind.c (uw_throw): Likewise.

4 files changed, 36 insertions, 6 deletions

diff --git a/eval.c b/eval.c
index e0880962..9b702866 100644
--- a/eval.c
+++ b/eval.c
@@ -104,6 +104,8 @@ val last_form_evaled, last_form_expanded;
 
 val call_f;
 
+val origin_hash;
+
 val make_env(val vbindings, val fbindings, val up_env)
 {
   val env = make_obj();
@@ -188,6 +190,11 @@ noreturn val eval_error(val form, val fmt, ...)
   abort();
 }
 
+val lookup_origin(val form)
+{
+  return gethash(origin_hash, form);
+}
+
 val lookup_global_var(val sym)
 {
   uses_or2;
@@ -1487,7 +1494,9 @@ static val expand_macro(val form, val expander, val menv)
 {
   if (cobjp(expander)) {
     mefun_t fp = coerce(mefun_t, cptr_get(expander));
-    return fp(form, menv);
+    val expanded = fp(form, menv);
+    sethash(origin_hash, expanded, form);
+    return expanded;
   } else {
     debug_enter;
     val name = car(form);
@@ -1504,6 +1513,7 @@ static val expand_macro(val form, val expander, val menv)
     result = eval_progn(body, exp_env, body);
     debug_end;
     set_dyn_env(saved_de);
+    sethash(origin_hash, result, form);
     debug_return(result);
     debug_leave;
   }
@@ -4189,7 +4199,7 @@ void eval_init(void)
 
   protect(&top_vb, &top_fb, &top_mb, &top_smb, &special, &builtin, &dyn_env,
           &op_table, &last_form_evaled, &last_form_expanded,
-          &call_f, convert(val *, 0));
+          &call_f, &origin_hash, convert(val *, 0));
   top_fb = make_hash(t, nil, nil);
   top_vb = make_hash(t, nil, nil);
   top_mb = make_hash(t, nil, nil);
@@ -4202,6 +4212,8 @@ void eval_init(void)
 
   call_f = func_n1v(generic_funcall);
 
+  origin_hash = make_hash(t, nil, nil);
+
   dwim_s = intern(lit("dwim"), user_package);
   progn_s = intern(lit("progn"), user_package);
   prog1_s = intern(lit("prog1"), user_package);
diff --git a/eval.h b/eval.h
index 05f9061f..78a0f8b0 100644
--- a/eval.h
+++ b/eval.h
@@ -31,6 +31,7 @@ extern val eq_s, eql_s, equal_s;
 extern val last_form_evaled, last_form_expanded;
 
 noreturn val eval_error(val form, val fmt, ...);
+val lookup_origin(val form);
 val make_env(val fbindings, val vbindings, val up_env);
 val copy_env(val oenv);
 val env_fbind(val env, val sym, val fun);
diff --git a/parser.c b/parser.c
index 258c77b8..c3c581e4 100644
--- a/parser.c
+++ b/parser.c
@@ -753,6 +753,7 @@ val repl(val bindings, val in_stream, val out_stream)
       } else if (uw_exception_subtype_p(exsym, error_s)) {
         val info = source_loc_str(last_form_evaled, nil);
         val ex_info = source_loc_str(last_form_expanded, nil);
+        val origin = last_form_evaled;
 
         if (cdr(exvals))
           format(out_stream, lit("** ~!~a ~!~s\n"),
@@ -760,13 +761,21 @@ val repl(val bindings, val in_stream, val out_stream)
         else
           format(out_stream, lit("** ~!~a\n"), car(exvals), nao);
 
-        if (info && exsym != eval_error_s)
-          format(std_error, lit("** possibly triggered at ~a by form ~!~s\n"),
+        if (info && exsym != eval_error_s) {
+          format(out_stream, lit("** possibly triggered at ~a by form ~!~s\n"),
                  info, last_form_evaled, nao);
 
+          while ((origin = lookup_origin(origin))) {
+            val oinfo = source_loc_str(origin, lit("(n/a)"));
+            format(out_stream, lit("** which is an expansion at ~a of ~!~s\n"),
+                   oinfo, origin, nao);
+          }
+        }
+
         if (ex_info)
-          format(std_error, lit("** during expansion at ~a of form ~!~s\n"),
+          format(out_stream, lit("** during expansion at ~a of form ~!~s\n"),
                  ex_info, last_form_expanded, nao);
+
       } else {
         format(out_stream, lit("** ~!~s exception, args: ~!~s\n"),
                exsym, exvals, nao);
diff --git a/unwind.c b/unwind.c
index 3846fa5c..866a6c4b 100644
--- a/unwind.c
+++ b/unwind.c
@@ -535,13 +535,21 @@ val uw_throw(val sym, val args)
       val msg_or_args = if3(is_msg, car(args), args);
       val info = source_loc_str(last_form_evaled, nil);
       val ex_info = source_loc_str(last_form_expanded, nil);
+      val origin = last_form_evaled;
       format(std_error, lit("~a: unhandled exception of type ~a:\n"),
              prog_string, sym, nao);
 
-      if (info && sym != eval_error_s)
+      if (info && sym != eval_error_s) {
         format(std_error, lit("~a: possibly triggered at ~a by form ~!~s\n"),
                prog_string, info, last_form_evaled, nao);
 
+        while ((origin = lookup_origin(origin))) {
+          val oinfo = source_loc_str(origin, lit("(n/a)"));
+          format(std_error, lit("~a: which is an expansion at ~a of ~!~s\n"),
+                 prog_string, oinfo, origin, nao);
+        }
+      }
+
       if (ex_info)
         format(std_error, lit("~a: during expansion at ~a of form ~!~s\n"),
                prog_string, ex_info, last_form_expanded, nao);