diff options
| -rw-r--r-- | share/txr/stdlib/defset.tl | 32 | ||||
| -rw-r--r-- | txr.1 | 33 |
2 files changed, 50 insertions, 15 deletions
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) @@ -34625,6 +34625,39 @@ Syntactic places defined by .code defset may not use improper syntax such as .codn "(set (g 1 2 . 3) v)" . +Although syntactic places defined by +.code defset +perform macro-parameter-like destructuring of the place form, binding +unevaluated argument expressions to the parameter symbols, +nested macro parameter lists are not supported: +.meta params +specifies a function parameter list. + +The parameter list may use parameter macros, keeping in mind that +the parameter expansion is applied at the time the +.code defset +form is processed, specifying an expanded parameter list which +receives unevaluated expressions. The +.meta get-form +and +.meta set-form +may refer to all symbols produced by parameter list expansion, other +than generated symbols. For instance, if a parameter list macro +.code :addx +exists which adds the parameter symbol +.code x +to the parameter list, and this +.code :addx +is invoked in the +.meta params +list of a +.codn defset , +then +.code x +will be visible to the +.meta get-form +and +.metn set-form . The short, two-argument form of .code defset |