From 705aafca215d6bf7b289f443fdebc4681776cf28 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Tue, 21 Mar 2023 19:42:14 -0700 Subject: Allow t symbol in macro parameter lists. * eval.c (expand_params_rec, bind_macro_params): Handle t specially everywhere a parameter can occur. Expansion allows the syntax through without extending the environment with a t variable; binding walks over the structure without binding a variable. * stdlib/compiler.tl (expand-bind-mac-params): Likewise, handle occurrences of t, suppressing the generation of and assignment to variables, while ensuring that initializing expressions are evaluated. * tests/011/tree-bind.tl: New file. * txr.1: Documented. --- stdlib/compiler.tl | 43 ++++++++++++++++++++++++------------------- 1 file changed, 24 insertions(+), 19 deletions(-) (limited to 'stdlib') 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 -- cgit v1.2.3