compiler: improvements in reporting form in diagnostics.

* eval.c (ctx_name): Do not report just the car
of the form. If the form starts with three symbols,
list those; if two, list those.

* stdlib/compiler.tl (expand-defun): Set the
defun form as the macro ancestor of the lambda,
rather than propagating source location info.
Then diagnostics that previously refer to a
lambda will correctly refer to the defun and
thank to the above change in eval.c, include
its name.

* stdlib/pmac.t (define-param-expander):
A similar change here. We make the define-param-expander
form the macro ancestor of the lambda, so that
diagnostics agains tthe lambda will show that
form.

1 files changed, 19 insertions, 5 deletions

diff --git a/eval.c b/eval.c
index a566cea8..75a3ffce 100644
--- a/eval.c
+++ b/eval.c
@@ -287,14 +287,27 @@ val ctx_form(val obj)
 val ctx_name(val obj)
 {
   if (consp(obj)) {
-    if (car(obj) == lambda_s)
-      return list(lambda_s, second(obj), nao);
-    else
-      return car(obj);
+    val a = car(obj);
+    val d = cdr(obj);
+    val ad = nil;
+
+    if (a == lambda_s) {
+      return list(lambda_s, car(d), nao);
+    } else if (consp(d) && (bindable((ad = car(d))) || keywordp(ad))) {
+      val dd = cdr(d);
+      val add = car(dd);
+      if (bindable(add))
+        return cons(a, cons(ad, cons(add, nil)));
+      else
+        return cons(a, cons(ad, nil));
+    } else {
+      return a;
+    }
   }
 
   if (interp_fun_p(obj))
     return func_get_name(obj, obj->f.env);
+
   return nil;
 }
 
@@ -2452,8 +2465,9 @@ static val expand_macrolet(val form, val menv)
     val macro = car(macs);
     val name = pop(&macro);
     val params = pop(&macro);
+    val orig = rlcp(cons(op, cons(name, nil)), form);
     cons_bind (params_ex, macro_ex,
-               expand_params(params, macro, menv, t, form));
+               expand_params(params, macro, menv, t, set_origin(form, orig)));
     val new_menv = make_var_shadowing_env(menv, get_param_syms(params_ex));
     val macro_out = expand_forms(macro_ex, new_menv);
     val block = rlcp_tree(cons(block_s, cons(name, macro_out)), macro_ex);