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.

1 files changed, 14 insertions, 2 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);