New placelet macro.

* lisplib.c (place_set_entries): Add placelet to list of names.

* share/txr/stdlib/place.tl (sys:placelet1, placelet): New macros.
(defplace dwim): Do not retrieve the
place's value into a local variable and have the getter
expand to that variable. Rather, have the getter retrieve the
value. A getter that refers to a cached copy breaks
the semantics of placelet, and any place operator which can
evaluate the location after it is stored.

* txr.1: Documented placelet.

4 files changed, 134 insertions, 11 deletions

diff --git a/ChangeLog b/ChangeLog
index d74f5226..a32c860b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,21 @@
 2015-07-10  Kaz Kylheku  <kaz@kylheku.com>
 
+	New placelet macro.
+
+	* lisplib.c (place_set_entries): Add placelet to list of names.
+
+	* share/txr/stdlib/place.tl (sys:placelet1, placelet): New macros.
+	(defplace dwim): Do not retrieve the
+	place's value into a local variable and have the getter
+	expand to that variable. Rather, have the getter retrieve the
+	value. A getter that refers to a cached copy breaks
+	the semantics of placelet, and any place operator which can
+	evaluate the location after it is stored.
+
+	* txr.1: Documented placelet.
+
+2015-07-10  Kaz Kylheku  <kaz@kylheku.com>
+
 	Handle setting of parse name through prime_parser.
 
 	* parser.c (prime_parser): Take name as argument,
diff --git a/lisplib.c b/lisplib.c
index 2a0357a5..9db0853d 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -68,6 +68,7 @@ static val place_set_entries(val dlt, val fun)
     lit("push"), lit("pop"), lit("swap"), lit("shift"), lit("rotate"),
     lit("pushnew"), lit("del"),
     lit("defplace"), lit("define-modify-macro"),
+    lit("placelet"),
     nil
   };
 
diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl
index 72e054fd..af03070f 100644
--- a/share/txr/stdlib/place.tl
+++ b/share/txr/stdlib/place.tl
@@ -421,17 +421,16 @@
                   (,index-sym (sys:l1-val ,index))
                   ,*(if have-default-p
                       ^((,dflval-sym (sys:l1-val ,default)))))
-             (let ((,oldval-sym [,obj-sym
-                                ,index-sym
-                                ,*(if have-default-p ^(,dflval-sym))]))
-               (macrolet ((,getter () ',oldval-sym)
-                          (,setter (val)
-                             ^(rlet ((,',newval-sym ,val))
-                                (,',osetter-sym
-                                  (sys:dwim-set ,',obj-sym
-                                                ,',index-sym ,',newval-sym))
-                                ,',newval-sym)))
-                  ,body)))))))
+             (macrolet ((,getter ()
+                         '[,obj-sym ,index-sym
+                                    ,*(if have-default-p ^(,dflval-sym))])
+                        (,setter (val)
+                           ^(rlet ((,',newval-sym ,val))
+                              (,',osetter-sym
+                                (sys:dwim-set ,',obj-sym
+                                              ,',index-sym ,',newval-sym))
+                              ,',newval-sym)))
+                ,body))))))
   (ssetter
     (with-gensyms (osetter-sym ogetter-sym
                    obj-sym newval-sym index-sym)
@@ -560,3 +559,27 @@
       ^(defmacro ,name (:env env ,place-sym ,*lambda-list)
          (with-update-expander (getter setter) ,place-sym env
            ^(,setter (,',function (,getter) ,,*cleaned-lambda-list)))))))
+
+(defmacro sys:placelet-1 (((sym place)) . body :env env)
+  (with-gensyms (tmp-place pl-getter pl-setter steal-getter)
+    (unwind-protect
+      (progn
+        (sethash *place-update-expander* tmp-place
+                 (lambda (tmp-getter tmp-setter tmp-place tmp-body)
+                   ^(macrolet ((,tmp-getter () ^(,',pl-getter))
+                               (,tmp-setter (val) ^(,',pl-setter ,val)))
+                      ,tmp-body)))
+        (call-update-expander pl-getter pl-setter place env
+          ^(macrolet ((,tmp-place () ^(,',pl-getter)))
+             ,(sys:expand
+                ^(symacrolet ((,sym (,tmp-place))) ,*body)
+                env))))
+      (remhash *place-update-expander* tmp-place))))
+
+(defmacro placelet (sym-place-pairs . body)
+  (tree-case sym-place-pairs
+    (() ^(progn ,*body))
+    (((sym place)) ^(sys:placelet-1 ((,sym ,place)) ,*body))
+    (((sym place) . rest-pairs) ^(sys:placelet-1 ((,sym ,place))
+                                   (placelet (,*rest-pairs) ,*body)))
+    (obj (throwf 'eval-error "placelet: bad syntax: ~s" obj))))
diff --git a/txr.1 b/txr.1
index 378169cd..ae27cc45 100644
--- a/txr.1
+++ b/txr.1
@@ -28659,6 +28659,89 @@ applies inside a
 form. Of course, lexical operator macros do not shadow
 symbol macros under any circumstances.
 
+.coNP Operator @ placelet
+.synb
+.mets (placelet >> ({( sym << place )}*) << body-form *)
+.syne
+.desc
+The
+.code placelet
+macro binds lexically scoped symbol macros in such
+a way that they behave as aliases for places
+denoted by place forms.
+
+Each
+.meta place
+must be an expression denoting a syntactic place. The
+corresponding
+.meta sym
+is established as an alias for the storage location which that place denotes,
+over the scope of the
+.metn body-form -s.
+
+This binding takes place in such a way that each
+.meta place
+is evaluated exactly once, only in order to determine its
+storage location.  The corresponding
+.meta sym
+then serves as an alias for that location, over the
+scope of the
+.metn body-form -s.
+This means that whenever
+.meta sym
+is evaluated, it stands for the value of the storage
+location, and whenever a value is apprently stored into
+.metn sym ,
+it is actually the storage location which receives it.
+
+Note: certain kinds of places, notably
+.cblk
+.meti (force << promise )
+.cble
+expressions, must be accessed before they can be stored,
+and this restriction continues to hold when those
+places are accessed through
+.code placelet
+aliases.
+
+Note:
+.code placelet
+differs from
+.code symacrolet
+in that the forms themselves are not aliased, but the storage
+locations which they denote.
+.code (symacrolet ((x y) z)
+performs the syntactic substitution of symbol
+.code x
+by form
+.codn y ,
+whereever
+.code x
+appears inside
+.code z
+as an evaluated form, and is not shadowed by any inner binding.
+Whereas
+.code (placelet ((x y)) z)
+generates code which arranges for
+.code y
+to be evaluated to a storage location, and syntactically replaces occurrences
+of
+.code x
+with a form which directly denotes that storage location,
+wherever
+.code x
+appears inside
+.code z
+as an evaluated form, and is not shadowed by any inner binding.
+Also,
+.code x
+is not necessarily substituted by a single, fixed form,
+as in the case of
+.codn symacrolet .
+Rather it may be substituted by one kind of form when it
+is treated as a pure value, and another kind of form
+when it is treated as a place.
+
 .coNP Operator @ tree-bind
 .synb
 .mets (tree-bind < macro-style-params < expr << form *)