diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2016-10-27 06:26:33 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2016-10-27 06:26:33 -0700 |
| commit | 7ae20049c6279c2dc99ca8de836e427c55e9ae9f (patch) | |
| tree | eca9827186f47d168157342883ccc5820c1fca88 | |
| parent | baad47e4514d8b976669ba71671cc2eccdf2d7e7 (diff) | |
| download | txr-7ae20049c6279c2dc99ca8de836e427c55e9ae9f.tar.gz txr-7ae20049c6279c2dc99ca8de836e427c55e9ae9f.tar.bz2 txr-7ae20049c6279c2dc99ca8de836e427c55e9ae9f.zip | |
dwim place: multiple accesses, eval order.
* share/txr/stdlib/place.tl (defplace dwim): In updater,
removing unused and redundant gensyms. Engaging unused
oldval-sym as a temporary to hold the result of invoking
(,ogetter-sym), the "getter" for the sequence object place we
are operating on. Both references then refer to this resut
instead of expanding the getter twice. Though getters should
not have side effects, they could be expensive. In simple
setter and deleter, setting up obj-sym similarly. We don't
make multiple accesses to the sequence, but we were evaluating
it in the wrong order w.r.t the index and new-val.
| -rw-r--r-- | share/txr/stdlib/place.tl | 37 |
1 files changed, 18 insertions, 19 deletions
diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl index ef1ec132..c2421c3c 100644 --- a/share/txr/stdlib/place.tl +++ b/share/txr/stdlib/place.tl @@ -657,21 +657,20 @@ (defplace (dwim obj-place index : (default nil have-default-p) :env env) body (getter setter (with-gensyms (ogetter-sym osetter-sym obj-sym - oldval-sym newval-sym - index-sym index-sym - oldval-sym dflval-sym) + index-sym dflval-sym newval-sym) (let ((sys:*lisp1* t)) (with-update-expander (ogetter-sym osetter-sym) obj-place nil - ^(let ((,index-sym (sys:l1-val ,index)) - ,*(if have-default-p - ^((,dflval-sym (sys:l1-val ,default))))) + ^(rlet ((,obj-sym (,ogetter-sym)) + (,index-sym (sys:l1-val ,index)) + ,*(if have-default-p + ^((,dflval-sym (sys:l1-val ,default))))) (macrolet ((,getter () - '[(,ogetter-sym) ,index-sym - ,*(if have-default-p ^(,dflval-sym))]) + '[,obj-sym ,index-sym + ,*(if have-default-p ^(,dflval-sym))]) (,setter (val) ^(rlet ((,',newval-sym ,val)) (,',osetter-sym - (sys:dwim-set (,',ogetter-sym) + (sys:dwim-set ,',obj-sym ,',index-sym ,',newval-sym)) ,',newval-sym))) ,body)))))) @@ -681,10 +680,11 @@ (let ((sys:*lisp1* t)) (with-update-expander (ogetter-sym osetter-sym) obj-place nil ^(macrolet ((,ssetter (val) - ^(rlet ((,',index-sym (sys:l1-val ,',index)) + ^(rlet ((,',obj-sym (,',ogetter-sym)) + (,',index-sym (sys:l1-val ,',index)) (,',newval-sym ,val)) (,',osetter-sym - (sys:dwim-set (,',ogetter-sym) + (sys:dwim-set ,',obj-sym ,*(if ,have-default-p ^((prog1 ,',index-sym @@ -696,17 +696,16 @@ (deleter (with-gensyms (osetter-sym ogetter-sym - obj-sym index-sym oldval-sym - dflval-sym) + obj-sym index-sym oldval-sym) (let ((sys:*lisp1* t)) (with-update-expander (ogetter-sym osetter-sym) obj-place nil ^(macrolet ((,deleter () ;; todo: place must not have optional val - ^(let ((,',obj-sym (,',ogetter-sym))) - (let* ((,',index-sym (sys:l1-val ,',index)) - (,',oldval-sym [,',obj-sym - ,',index-sym - ,*(if ,have-default-p - ^(,',default))])) + ^(rlet ((,',obj-sym (,',ogetter-sym)) + (,',index-sym (sys:l1-val ,',index))) + (let ((,',oldval-sym [,',obj-sym + ,',index-sym + ,*(if ,have-default-p + ^(,',default))])) (progn (,',osetter-sym (sys:dwim-del ,',obj-sym ,',index-sym)) |