diff options
| -rw-r--r-- | share/txr/stdlib/defset.tl | 22 | ||||
| -rw-r--r-- | tests/012/defset.tl | 14 | ||||
| -rw-r--r-- | txr.1 | 10 |
3 files changed, 23 insertions, 23 deletions
diff --git a/share/txr/stdlib/defset.tl b/share/txr/stdlib/defset.tl index d666f199..5312d5dd 100644 --- a/share/txr/stdlib/defset.tl +++ b/share/txr/stdlib/defset.tl @@ -63,7 +63,12 @@ (fixpars (append fp.req fp.(opt-syms))) (restpar (if (symbol-package fp.rest) fp.rest)) (extsyms [keep-if symbol-package - (diff total-syms (cons restpar fixpars))])) + (diff total-syms (cons restpar fixpars))]) + (nvsym (gensym)) + (xsetform ^^(alet ((,',nvsym ,,newval)) + ,,(expand ^(symacrolet ((,newval ',nvsym)) + ,setform) + env)))) (with-gensyms (getter setter args gpf-pairs gpr-pairs ext-pairs pgens rgens egens all-pairs agens) ^(defplace (,name . ,args) body @@ -94,7 +99,8 @@ ^((,',restpar ',,rgens)) ^((,',restpar ',(car ,rgens)))))) (macrolet ((,,getter () ^(,',',name ,',*,agens)) - (,,setter (,',newval) ,',setform)) + (,,setter (,',newval) + ,',xsetform)) ,body)) ,env))))))))) @@ -107,16 +113,10 @@ (x (compile-error mf "invalid syntax")))) (defset sub-list (list : (from 0) (to t)) items - (let ((it (gensym))) - ^(alet ((,it ,items)) - (progn (set ,list (replace-list ,list ,it ,from ,to)) ,it)))) + ^(progn (set ,list (replace-list ,list ,items ,from ,to)) ,items)) (defset sub-vec (vec : (from 0) (to t)) items - (let ((it (gensym))) - ^(alet ((,it ,items)) - (progn (replace-vec ,vec ,it ,from ,to) ,it)))) + ^(progn (replace-vec ,vec ,items ,from ,to) ,items)) (defset sub-str (str : (from 0) (to t)) items - (let ((it (gensym))) - ^(alet ((,it ,items)) - (progn (replace-str ,str ,it ,from ,to) ,it)))) + ^(progn (replace-str ,str ,items ,from ,to) ,items)) diff --git a/tests/012/defset.tl b/tests/012/defset.tl index 601be292..110f3c64 100644 --- a/tests/012/defset.tl +++ b/tests/012/defset.tl @@ -2,10 +2,20 @@ (defset foo (:key x y -- a b c (d 4)) n ^(bar ,x ,y, a, b, c ,d ,n)) +;; obtain identity of new-val gensym: this is baked into defset +(defvarl %new-val-sym% (caar (last (cadr (expand '(inc (foo 1 2))))))) + +(test + (and (symbolp %new-val-sym%) + (null (symbol-package %new-val-sym%)) + (starts-with "g" (symbol-name %new-val-sym%))) + t) + (test (expand '(set (foo 1 2 :a 3 :b 4) 5)) (bar 1 2 3 4 nil 4 5)) -(test +(vtest (expand '(inc (foo 1 2 :a 3 :b 4) 5)) - (bar 1 2 3 4 nil 4 (+ (foo 1 2 :a 3 :b 4) 5))) + ^(let ((,%new-val-sym% (+ (foo 1 2 :a 3 :b 4) 5))) + (bar 1 2 3 4 () 4 ,%new-val-sym%))) @@ -36204,16 +36204,6 @@ the parameter list .metn params . The -.meta new-val-sym -parameter is the name of a symbol which will be bound to -an expression which calculates the new value being stored into -the syntactic place. This is intended to be referenced in the -.meta set-form -only, which should ensure that the expression that -.meta new-val-sym -holds is evaluated only once. - -The .meta set-form argument specifies an expression which generates the code for storing a new value to the place. |