diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2023-03-21 19:42:14 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2023-03-21 19:42:14 -0700 |
| commit | 705aafca215d6bf7b289f443fdebc4681776cf28 (patch) | |
| tree | 41590ad1bfeb008bf6803418cd5d2068ef663146 /stdlib | |
| parent | 2b717de5d7949688c7c639414a5765cbc4169f8c (diff) | |
| download | txr-705aafca215d6bf7b289f443fdebc4681776cf28.tar.gz txr-705aafca215d6bf7b289f443fdebc4681776cf28.tar.bz2 txr-705aafca215d6bf7b289f443fdebc4681776cf28.zip | |
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.
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/compiler.tl | 43 |
1 files changed, 24 insertions, 19 deletions
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 |