From 7ae20049c6279c2dc99ca8de836e427c55e9ae9f Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Thu, 27 Oct 2016 06:26:33 -0700
Subject: 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.
---
 share/txr/stdlib/place.tl | 37 ++++++++++++++++++-------------------
 1 file 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))
-- 
cgit v1.2.3