From c0d469720866b2b6139fa9af862f0c7316117e37 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Fri, 8 Mar 2019 08:17:28 -0800 Subject: defset: support parameter macros. * defset.tl (defset-expander): Add logic to expand parameter list to determine additional paramters that may come out of the expansion, as well as additional symbols that may be visible as a result as a result of processing in the expanded body. These symbols are included in the same way as original the original parameters. * txr.1: Documented defset's support for parameter list macros. --- share/txr/stdlib/defset.tl | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) (limited to 'share') diff --git a/share/txr/stdlib/defset.tl b/share/txr/stdlib/defset.tl index 9b1c9559..3fd8de2e 100644 --- a/share/txr/stdlib/defset.tl +++ b/share/txr/stdlib/defset.tl @@ -56,37 +56,39 @@ ,body))))))) (defun defset-expander (env macform name params newval getform setform) - (let* ((fp (new fun-param-parser form macform syntax params)) + (let* ((ap (analyze-params params)) + (exp-params (car ap)) + (total-syms (cadr ap)) + (fp (new fun-param-parser form macform syntax exp-params)) (fixpars (append fp.req fp.(opt-syms))) - (restpar fp.rest)) + (restpar (if (symbol-package fp.rest) fp.rest)) + (extsyms [keep-if symbol-package + (diff total-syms (cons restpar fixpars))])) (with-gensyms (getter setter) ^(defplace (,name ,*params) body (,getter ,setter - (let* ((gpf-pairs (append (mapcar (op list (gensym) @1) + (let* ((gpf-pairs (append (mapcar (op list (gensym)) (list ,*fixpars)))) (gpr-pairs (if ',restpar - (mapcar (ret ^(,(gensym) ,@1)) ,restpar))) + (mapcar (op list (gensym)) ,restpar))) + (ext-pairs (mapcar (op list (gensym)) (list ,*extsyms))) (pgens [mapcar car gpf-pairs]) - (rgens [mapcar car gpr-pairs])) - ^(alet (,*gpf-pairs ,*gpr-pairs) + (rgens [mapcar car gpr-pairs]) + (egens [mapcar car ext-pairs])) + ^(alet (,*gpf-pairs ,*gpr-pairs ,*ext-pairs) ,(expand ^(symacrolet (,*(zip ',fixpars (mapcar (ret ^',@1) pgens)) - ,*(if gpr-pairs - ^((,',restpar ',rgens)))) + ,*(zip ',extsyms + (mapcar (ret ^',@1) egens)) + ,*(if gpr-pairs + ^((,',restpar ',rgens)))) (macrolet ((,,getter () ,',getform) (,,setter (,',newval) ,',setform)) ,body)) ,env)))))))) -(defun defset-expander-hairy (env macform name params newval getform setform) - (compile-error macform "param list macro support is being researched")) - (defmacro usr:defset (:env e :form mf . args) (tree-case args - ((name (param . params) newval getform setform) - (if (and (keywordp param) (neq : param)) - (defset-expander-hairy e mf . args) - (defset-expander e mf . args))) ((name (. params) newval getform setform) (defset-expander e mf . args)) ((get-fun set-fun) -- cgit v1.2.3