Improve bad argument diagnosis for place macros.

* eval.c (op_mac_param_bind): New static function.
(eval_init): Register mac-param-bind operator.

* share/txr/stdlib/place.tl (define-place-macro): Use
mac-param-bind inside a lambda instead of tb macro.

* txr.1: Document mac-param-bind.

4 files changed, 48 insertions, 3 deletions

diff --git a/ChangeLog b/ChangeLog
index d73ad31d..89cfac5f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,17 @@
 2015-07-22  Kaz Kylheku  <kaz@kylheku.com>
 
+	Improve bad argument diagnosis for place macros.
+
+	* eval.c (op_mac_param_bind): New static function.
+	(eval_init): Register mac-param-bind operator.
+
+	* share/txr/stdlib/place.tl (define-place-macro): Use
+	mac-param-bind inside a lambda instead of tb macro.
+
+	* txr.1: Document mac-param-bind.
+
+2015-07-22  Kaz Kylheku  <kaz@kylheku.com>
+
 	Implementing second through tenth as places.
 
 	* eval.c (eval_init): Register second through tenth as intrinsic.
diff --git a/eval.c b/eval.c
index 0a9e89de..67ac400d 100644
--- a/eval.c
+++ b/eval.c
@@ -1667,6 +1667,18 @@ static val op_tree_bind(val form, val env)
   return eval_progn(body, new_env, body);
 }
 
+static val op_mac_param_bind(val form, val env)
+{
+  val body = cdr(form);
+  val ctx_form = pop(&body);
+  val params = pop(&body);
+  val expr = pop(&body);
+  val ctx_val = eval(ctx_form, env, ctx_form);
+  val expr_val = eval(expr, env, expr);
+  val new_env = bind_macro_params(env, nil, params, expr_val, nil, ctx_val);
+  return eval_progn(body, new_env, body);
+}
+
 static val op_setq(val form, val env)
 {
   val args = rest(form);
@@ -4031,6 +4043,7 @@ void eval_init(void)
   reg_op(defsymacro_s, op_defsymacro);
   reg_op(tree_case_s, op_tree_case);
   reg_op(tree_bind_s, op_tree_bind);
+  reg_op(intern(lit("mac-param-bind"), user_package), op_mac_param_bind);
   reg_op(setq_s, op_setq);
   reg_op(intern(lit("lisp1-setq"), system_package), op_lisp1_setq);
   reg_op(sys_lisp1_value_s, op_lisp1_value);
diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl
index 67a593fb..e19caa2f 100644
--- a/share/txr/stdlib/place.tl
+++ b/share/txr/stdlib/place.tl
@@ -310,9 +310,12 @@
                       ,delete-body)))))))))
 
 (defmacro define-place-macro (name place-destructuring-args . body)
-  (with-gensyms (name-dummy)
+  (with-gensyms (name-dummy args)
     ^(sethash *place-macro* ',name
-              (tb ((,name-dummy ,*place-destructuring-args)) ,*body))))
+              (lambda (,args)
+                (mac-param-bind ,args
+                                (,name-dummy ,*place-destructuring-args)
+                                ,args ,*body)))))
 
 (defplace (sys:var arg) body
   (getter setter
diff --git a/txr.1 b/txr.1
index 53b90055..3bf4c4ae 100644
--- a/txr.1
+++ b/txr.1
@@ -29003,9 +29003,10 @@ Rather it may be substituted by one kind of form when it
 is treated as a pure value, and another kind of form
 when it is treated as a place.
 
-.coNP Operator @ tree-bind
+.coNP Operators @ tree-bind and @ mac-param-bind
 .synb
 .mets (tree-bind < macro-style-params < expr << form *)
+.mets (mac-param-bind < context-expr < macro-style-params < expr << form *)
 .syne
 .desc
 The
@@ -29031,6 +29032,22 @@ structural mismatch between the parameters and the value of
 One way to avoid this exception is to use
 .codn tree-case .
 
+The
+.code mac-param-bind
+operator is similar to
+.code tree-bind
+except that it takes an extra argument,
+.metn context-expr.
+This argument is an expression which is evaluated. It is expected to
+evaluate to a compound form. If an error occurs during binding, the error
+diagnostic message is based on information obtained from this form.
+By contrast, the
+.code tree-bind
+operator's error diagnostic refers to the
+.code tree-bind
+form, which is cryptic if the binding is used for the implementation
+of some other construct, hidden from the user of that construct.
+
 .coNP Operator @ tree-case
 .synb
 .mets (tree-case < expr >> {( macro-style-params  << form *)}*)