expander: support param macros in nested macro param lists.

Parameter list macros work in inside macro parameter lists,
like they do in function parameter lists. However, they
ony work at the top level. Macro parameter lists are nested;
they may contain nested parameter lists that match
corresponding shapes in the argument list.
This patch extends parameter list macros to work in
nested macro parameter lists.

* eval.c (expand_opt_params_rec, expand_params_rec):
These two functions must be extended to take a body
argument, and to return not just an expanded parameter
list but a parameter list accompanied by a body.
We do that by making them return a cons cell, whose
car is the expanded parameter list and the cdr is
the possibly transformed body. Additionally, these
functions now call expand_param_macro on nested
macro parameter lists.
(expand_params): This function becomes slightly simpler
as a result of the above changes. Because expand_params_rec
already returns a cons cell holding a parameter list and
body, we just return that as-is.

* tests/011/keyparams.tl: Added some tests of this, vie the
standard :key parameter list macro. A macro is tested
which has a nested (:key ...) parameter list in a required
parameter position as well as in an optional position.

* txr.1: Documented.

1 files changed, 56 insertions, 38 deletions

diff --git a/eval.c b/eval.c
index aecc5a8e..bed22691 100644
--- a/eval.c
+++ b/eval.c
@@ -1083,19 +1083,19 @@ static val make_var_shadowing_env(val menv, val vars);
 static val get_param_syms(val params);
 
 static val expand_params_rec(val params, val menv, val macro_style_p,
-                             val form);
+                             val body, val form);
+
+static val expand_param_macro(val params, val body, val menv, val form);
 
 static val expand_opt_params_rec(val params, val menv,
-                                 val macro_style_p, val form)
+                                 val macro_style_p, val body, val form)
 {
-  if (!params) {
-    return params;
-  } else if (params == t && macro_style_p) {
-    return params;
+  if (!params || (params == t && macro_style_p)) {
+    return cons(params, body);
   } else if (atom(params)) {
     if (!bindable(params))
       not_bindable_error(form, params);
-    return params;
+    return cons(params, body);
   } else {
     val pair = car(params);
     if (atom(pair)) {
@@ -1121,22 +1121,24 @@ static val expand_opt_params_rec(val params, val menv,
       }
 
       {
-        val params_ex = expand_opt_params_rec(cdr(params), new_menv,
-                                              macro_style_p, form);
-
-
-        if (params_ex == cdr(params))
-          return params;
-        return rlcp(cons(pair, params_ex), cdr(params));
+        val rest_params = cdr(params);
+        cons_bind (params_ex, body_ex,
+                   expand_opt_params_rec(rest_params, new_menv,
+                                         macro_style_p, body, form));
+        if (params_ex == rest_params && body_ex == body)
+          return cons(params, body);
+        return cons(rlcp(cons(pair, params_ex), rest_params), body_ex);
       }
     } else if (!macro_style_p && !bindable(car(pair))) {
       expand_error(form, lit("~s: parameter symbol expected, not ~s"),
                    car(form), car(pair), nao);
     } else {
       val param = car(pair);
-      val param_ex = expand_params_rec(param, menv,
-                                       macro_style_p,
-                                       form);
+      cons_bind (param_ex0, body_ex0,
+                 expand_param_macro(param, body, menv, form));
+      cons_bind (param_ex, body_ex,
+                 expand_params_rec(param_ex0, menv, macro_style_p,
+                                   body_ex0, form));
       val initform = cadr(pair);
       val initform_ex = rlcp(expand(initform, menv), initform);
       val opt_sym = caddr(pair);
@@ -1154,28 +1156,36 @@ static val expand_opt_params_rec(val params, val menv,
           not_bindable_error(form, opt_sym);
       }
 
-      return rlcp(cons(form_ex, expand_opt_params_rec(rest(params), new_menv,
-                                                      macro_style_p, form)),
-                  cdr(params));
+      {
+        val rest_params = cdr(params);
+        cons_bind (rest_params_ex, body_ex,
+                   expand_opt_params_rec(rest_params, new_menv,
+                                         macro_style_p, body_ex, form));
+
+        return cons(rlcp(cons(form_ex, rest_params_ex), rest_params),
+                    body_ex);
+      }
     }
   }
 }
 
 static val expand_params_rec(val params, val menv,
-                             val macro_style_p, val form)
+                             val macro_style_p, val body, val form)
 {
   if (!params) {
-    return params;
+    return cons(params, body);
   } else if (atom(params)) {
     if (!bindable(params) && (!macro_style_p || params != t))
       not_bindable_error(form, params);
-    return params;
+    return cons(params, body);
   } else if (car(params) == colon_k) {
-    val params_ex = expand_opt_params_rec(cdr(params), menv,
-                                          macro_style_p, form);
-    if (params_ex == cdr(params))
-      return params;
-    return rlcp(cons(colon_k, params_ex), cdr(params));
+    cons_bind (params_ex, body_ex,
+               expand_opt_params_rec(cdr(params), menv,
+                                         macro_style_p, body, form));
+    if (params_ex == cdr(params) && body_ex == body)
+      return cons(params, body);
+    return cons(rlcp(cons(colon_k, params_ex), cdr(params)),
+                body_ex);
   } else if (!macro_style_p && consp(car(params))) {
     expand_error(form, lit("~s: parameter symbol expected, not ~s"),
                  car(form), car(params), nao);
@@ -1198,19 +1208,28 @@ static val expand_params_rec(val params, val menv,
     } else if (bindable(param) || (macro_style_p &&
                                    (listp(param) || param == t)))
     {
-      param_ex = expand_params_rec(param, menv, t, form);
+      cons_bind (param_ex0, body_ex0,
+                 expand_param_macro(param, body, menv, form));
+      cons_bind (param_ex1, body_ex1,
+                 expand_params_rec(param_ex0, menv, t, body_ex0, form));
+      param_ex = param_ex1;
+      body = body_ex1;
       new_menv = make_var_shadowing_env(menv, get_param_syms(param_ex));
     } else {
       not_bindable_error(form, param);
     }
 
     {
-      val params_ex = expand_params_rec(cdr(params), new_menv,
-                                        macro_style_p,
-                                        form);
-      if (param_ex == car(params) && params_ex == cdr(params))
-        return params;
-      return rlcp(cons(param_ex, params_ex), params);
+      cons_bind (params_ex, body_ex,
+                 expand_params_rec(cdr(params), new_menv, macro_style_p,
+                                   body, form));
+
+      if (param_ex == car(params) && params_ex == cdr(params) &&
+          body_ex == body)
+      {
+        return cons(params, body);
+      }
+      return cons(rlcp(cons(param_ex, params_ex), params), body_ex);
     }
   }
 }
@@ -1251,9 +1270,8 @@ static val expand_param_macro(val params, val body, val menv, val form)
 static val expand_params(val params, val body, val menv,
                          val macro_style_p, val form)
 {
-  cons_bind (params_ex0, body_ex, expand_param_macro(params, body, menv, form));
-  val params_ex = expand_params_rec(params_ex0, menv, macro_style_p, form);
-  return cons(params_ex, body_ex);
+  cons_bind (params_ex, body_ex, expand_param_macro(params, body, menv, form));
+  return expand_params_rec(params_ex, menv, macro_style_p, body_ex, form);
 }
 
 static val get_opt_param_syms(val params)