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.

3 files changed, 27 insertions, 13 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);
diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl
index b516d91a..349fd9ab 100644
--- a/stdlib/compiler.tl
+++ b/stdlib/compiler.tl
@@ -2145,7 +2145,7 @@
 (defun expand-defun (form)
   (mac-param-bind form (t name args . body) form
     (flet ((mklambda (block-name block-sym)
-             (rlcp ^(lambda ,args (,block-sym ,block-name ,*body)) form)))
+             (set-macro-ancestor ^(lambda ,args (,block-sym ,block-name ,*body)) form)))
       (cond
         ((bindable name)
          ^(sys:rt-defun ',name ,(mklambda name 'sys:blk)))
diff --git a/stdlib/pmac.tl b/stdlib/pmac.tl
index d56e1fda..1f383e6f 100644
--- a/stdlib/pmac.tl
+++ b/stdlib/pmac.tl
@@ -25,14 +25,14 @@
 ;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 ;; POSSIBILITY OF SUCH DAMAGE.
 
-(defmacro define-param-expander (keyword
+(defmacro define-param-expander (:form f keyword
                                   (parms body : (env (gensym)) (form (gensym)))
-                                . forms)
-  ^(progn
-     (set [*param-macro* ,keyword]
-          (lambda (,parms ,body ,env ,form)
-            ,*forms))
-     ,keyword))
+                                  . forms)
+  (let ((lambda ^(lambda (,parms ,body ,env ,form) ,*forms)))
+    (set-macro-ancestor lambda f)
+    ^(progn
+       (set [*param-macro* ,keyword] ,lambda)
+       ,keyword)))
 
 (defun macroexpand-params (prototype-form : env)
   (tree-case prototype-form