diff options
| -rw-r--r-- | eval.c | 25 | ||||
| -rw-r--r-- | stdlib/compiler.tl | 43 | ||||
| -rw-r--r-- | tests/011/tree-bind.tl | 20 | ||||
| -rw-r--r-- | txr.1 | 20 |
4 files changed, 80 insertions, 28 deletions
@@ -1072,6 +1072,8 @@ static val expand_opt_params_rec(val params, val menv, { if (!params) { return params; + } else if (params == t && macro_style_p) { + return params; } else if (atom(params)) { if (!bindable(params)) not_bindable_error(form, params); @@ -1091,13 +1093,13 @@ static val expand_opt_params_rec(val params, val menv, if (pair == env_k && !bindable(cadr(params))) expand_error(form, lit("~s: ~s parameter requires bindable symbol"), car(form), pair, nao); - } else if (!bindable(pair)) { + } else if (!bindable(pair) && (!macro_style_p || pair != t)) { if (pair == colon_k) expand_error(form, lit("~s: multiple colons in parameter list"), car(form), nao); not_bindable_error(form, pair); - } else { - new_menv = make_var_shadowing_env(menv, pair); + } else if (pair != t) { + new_menv = make_var_shadowing_env(menv, pair); } { @@ -1130,7 +1132,7 @@ static val expand_opt_params_rec(val params, val menv, car(form), pair, cdddr(pair), nao); if (opt_sym) { - if (!bindable(opt_sym)) + if (!bindable(opt_sym) && (!macro_style_p || opt_sym != t)) not_bindable_error(form, opt_sym); } @@ -1147,7 +1149,7 @@ static val expand_params_rec(val params, val menv, if (!params) { return params; } else if (atom(params)) { - if (!bindable(params)) + if (!bindable(params) && (!macro_style_p || params != t)) not_bindable_error(form, params); return params; } else if (car(params) == colon_k) { @@ -1175,7 +1177,9 @@ static val expand_params_rec(val params, val menv, expand_error(form, lit("~s: ~s parameter requires bindable symbol"), car(form), param, nao); param_ex = param; - } else if (bindable(param) || (macro_style_p && listp(param))) { + } else if (bindable(param) || (macro_style_p && + (listp(param) || param == t))) + { param_ex = expand_params_rec(param, menv, t, form); new_menv = make_var_shadowing_env(menv, get_param_syms(param_ex)); } else { @@ -1400,7 +1404,7 @@ static val bind_macro_params(val env, val menv, val params, val form, if (atom(nparam)) { lex_or_dyn_bind(&dyn_env_made, new_env, nparam, bform); - } else { + } else if (param != t) { new_env = bind_macro_params(new_env, menv, nparam, bform, loose_p, ctx_form, error_fn); if (!new_env) @@ -1424,7 +1428,7 @@ static val bind_macro_params(val env, val menv, val params, val form, if (!listp(param)) { lex_or_dyn_bind(&dyn_env_made, new_env, param, car(form)); - } else { + } else if (param != t) { if (optargs) { val nparam = pop(¶m); val initform = pop(¶m); @@ -1467,7 +1471,7 @@ static val bind_macro_params(val env, val menv, val params, val form, noarg: if (!listp(param)) { lex_or_dyn_bind(&dyn_env_made, new_env, param, nil); - } else { + } else if (param != t) { val nparam = pop(¶m); val initform = pop(¶m); val presentsym = pop(¶m); @@ -1488,6 +1492,9 @@ noarg: params = cdr(params); } + if (params == t) + goto out; + if (params) { lex_or_dyn_bind(&dyn_env_made, new_env, params, form); goto out; diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl index 226bc132..5944e468 100644 --- a/stdlib/compiler.tl +++ b/stdlib/compiler.tl @@ -1945,17 +1945,19 @@ (push ^(when ,check-var ,form) stmt) (push form stmt)))) (emit-var (sym init-form) - (push (if stmt - (prog1 - ^(,sym (progn ,*(nreverse stmt) - ,(if check-var - ^(when ,check-var ,init-form) - init-form))) - (set stmt nil)) - ^(,sym ,(if check-var - ^(when ,check-var ,init-form) - init-form))) - vars))) + (if (eq sym t) + (emit-stmt init-form) + (push (if stmt + (prog1 + ^(,sym (progn ,*(nreverse stmt) + ,(if check-var + ^(when ,check-var ,init-form) + init-form))) + (set stmt nil)) + ^(,sym ,(if check-var + ^(when ,check-var ,init-form) + init-form))) + vars)))) (let ((pars (new (mac-param-parser par-syntax ctx-form)))) (progn (cond @@ -1989,9 +1991,9 @@ (emit-stmt ^(set ,obj-var (cdr ,obj-var))) (expand-rec p curs check-var) (put-gen curs))) - (t - (emit-var p ^(car ,obj-var)) - (emit-stmt ^(set ,obj-var (cdr ,obj-var)))))) + (t (if (neq p t) + (emit-var p ^(car ,obj-var))) + (emit-stmt ^(set ,obj-var (cdr ,obj-var)))))) (each ((o pars.opt)) (tree-bind (p : init-form pres-p) o (cond @@ -2019,13 +2021,16 @@ (emit-var pres-p ^(cond (,obj-var - (set ,p (car ,obj-var)) + ,(if (neq p t) + ^(set ,p (car ,obj-var))) (set ,obj-var (cdr ,obj-var)) - ,(if pres-p t)) + t) (t - ,(if init-form - ^(set ,p ,init-form)) - ,(if pres-p nil))))) + ,(cond + ((and (neq p t) init-form) + ^(set ,p ,init-form)) + (init-form)) + nil)))) (t (emit-var p ^(if ,obj-var (prog1 diff --git a/tests/011/tree-bind.tl b/tests/011/tree-bind.tl new file mode 100644 index 00000000..83fcaa33 --- /dev/null +++ b/tests/011/tree-bind.tl @@ -0,0 +1,20 @@ +(load "../common") + +(mtest + (tree-bind b '(1 2) b) (1 2) + (tree-bind (t b) '(1 2) b) 2 + (tree-bind (t . b) '(1 2) b) (2) + (tree-bind (b t) '(1 2) b) 1 + (tree-bind (b . t) '(1 2) b) 1 + (tree-bind t '(1 2) 3) 3 + (tree-bind (t : b) '(1 2) b) 2 + (tree-bind (b : t) '(1) b) 1 + (tree-bind (b : (t 2)) '(1) b) 1 + (tree-bind (b : (a 2 t)) '(1) a) 2 + (let ((i 0)) (tree-bind (b : (t (inc i) t)) '(1) (cons i b))) (1 . 1) + (let ((i 0)) (tree-bind (b : (t (inc i) t)) '(1 2) (cons i b))) (0 . 1)) + +(compile-only + (eval-only + (compile-file (base-name *load-path*) "temp.tlo") + (remove-path "temp.tlo"))) @@ -39715,6 +39715,21 @@ and .codn "(d e)" . These compounds express nested macro parameter lists. +Starting in \*(TX 285, the symbol +.code t +can be used in a macro parameter list in place of a parameter name. +This indicates that an object is expected at that position in the +corresponding structure, but no variable will be bound. +For completeness, the +.code t +symbol may also be used for a presence-indicating variable. +When the name of an optional parameter is specified as +.codn t , +and the corresponding structure is missing, the +.meta init-val +expression, if present, is still evaluated under the same +circumstances as it would if a variable were present. + Nested macro parameter lists recursively match the corresponding structure in the argument object. For instance if a simple argument would capture the structure @@ -39846,6 +39861,11 @@ and binds to the entire .code tree-bind form. +ANSI CL doesn't support the convention that the +.code t +symbol may appear instead of a parameter symbol to +suppress the binding of a variable. + .NP* The Macro Expansion Process The following description omits the treatment of top-level forms by |