summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2016-10-27 06:26:33 -0700
committerKaz Kylheku <kaz@kylheku.com>2016-10-27 06:26:33 -0700
commit3bd7d284921255462dbc3b46dc6120a9023cedf7 (patch)
treeeca9827186f47d168157342883ccc5820c1fca88
parent421f7d9c4c9d3d19d3e0b1cdffd3c72d32a17c98 (diff)
downloadtxr-3bd7d284921255462dbc3b46dc6120a9023cedf7.tar.gz
txr-3bd7d284921255462dbc3b46dc6120a9023cedf7.tar.bz2
txr-3bd7d284921255462dbc3b46dc6120a9023cedf7.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.tl37
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))