Relax restrictions on dwim places.

No longer require the leftmost expression in a dwim place to
itself be a place, except when the expression evaluates to
a list, and the list is subject to an element deletion or
a range operation.

* eval.c (eval_init): Register dwim-set and dwim-del with
one additional argument that the C functions now take.

* lib.c (dwim_set, dwim_del): Take a new place_p argument
which informs these functions whether the object they
are operating on came from a syntactic place. The forbidden
situations are diagnosed based on this flag: modification
of the subrange of a list, or deletion of a list ref.
Some error messages reworded.

* lib.h (dwim_set, dwim_del): Declarations updated.

* share/txr/stdlib/place.tl (defplace dwim): Produce a
different update, clobber and delete expansion when
the obj-place form isn't a place. In the non-place case,
do not assign the result of the sys:dwim-set or
sys:dwim-del operation back obj-place. Furthermore,
pass a Boolean flag to sys:dwim-set and sys:dwim-del
indicating which situation is the case: did the object
argument come from a place or non-place.

* txr.1: Documentation updated.

1 files changed, 54 insertions, 22 deletions

diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl
index eaf6bda6..7112f0ae 100644
--- a/share/txr/stdlib/place.tl
+++ b/share/txr/stdlib/place.tl
@@ -659,32 +659,54 @@
     (with-gensyms (ogetter-sym osetter-sym obj-sym newval-sym)
       (let ((arg-syms (mapcar (ret (gensym)) args))
             (sys:*lisp1* t))
-        (with-update-expander (ogetter-sym osetter-sym) obj-place nil
-          ^(rlet ((,obj-sym (,ogetter-sym))
+        (if (place-form-p obj-place sys:*pl-env*)
+          (with-update-expander (ogetter-sym osetter-sym) obj-place nil
+            ^(rlet ((,obj-sym (,ogetter-sym))
+                    ,*(mapcar (ret ^(,@1 (sys:l1-val ,@2))) arg-syms args))
+               (macrolet ((,getter ()
+                            '[,obj-sym ,*arg-syms])
+                          (,setter (val)
+                            ^(rlet ((,',newval-sym ,val))
+                               (,',osetter-sym
+                                 (sys:dwim-set t ,',obj-sym
+                                               ,*',arg-syms ,',newval-sym))
+                               ,',newval-sym)))
+                 ,body)))
+          ^(rlet ((,obj-sym ,obj-place)
                   ,*(mapcar (ret ^(,@1 (sys:l1-val ,@2))) arg-syms args))
              (macrolet ((,getter ()
                           '[,obj-sym ,*arg-syms])
                         (,setter (val)
                           ^(rlet ((,',newval-sym ,val))
-                             (,',osetter-sym
-                               (sys:dwim-set ,',obj-sym
-                                             ,*',arg-syms ,',newval-sym))
+                             (sys:dwim-set nil ,',obj-sym
+                                           ,*',arg-syms ,',newval-sym)
                              ,',newval-sym)))
                ,body))))))
   (ssetter
     (with-gensyms (osetter-sym ogetter-sym obj-sym newval-sym)
       (let ((arg-syms (mapcar (ret (gensym)) args))
             (sys:*lisp1* t))
-        (with-update-expander (ogetter-sym osetter-sym) obj-place nil
+        (if (place-form-p obj-place sys:*pl-env*)
+          (with-update-expander (ogetter-sym osetter-sym) obj-place nil
+            ^(macrolet ((,ssetter (val)
+                         ^(rlet ((,',obj-sym (,',ogetter-sym))
+                                 ,*(mapcar (ret ^(,@1 (sys:l1-val ,@2)))
+                                           ',arg-syms ',args)
+                                 (,',newval-sym ,val))
+                            (,',osetter-sym
+                              (sys:dwim-set t ,',obj-sym
+                                            ,*',arg-syms
+                                            ,',newval-sym))
+                            ,',newval-sym)))
+                 ,body))
           ^(macrolet ((,ssetter (val)
-                       ^(rlet ((,',obj-sym (,',ogetter-sym))
+                       ^(rlet ((,',obj-sym ,',obj-place)
                                ,*(mapcar (ret ^(,@1 (sys:l1-val ,@2)))
                                          ',arg-syms ',args)
                                (,',newval-sym ,val))
-                          (,',osetter-sym
-                            (sys:dwim-set ,',obj-sym
-                                          ,*',arg-syms
-                                          ,',newval-sym))
+                          (sys:dwim-set nil ,',obj-sym
+                                        ,*',arg-syms
+                                        ,',newval-sym)
                           ,',newval-sym)))
                ,body)))))
 
@@ -692,17 +714,27 @@
     (with-gensyms (osetter-sym ogetter-sym obj-sym oldval-sym)
       (let ((arg-syms (mapcar (ret (gensym)) args))
             (sys:*lisp1* t))
-        (with-update-expander (ogetter-sym osetter-sym) obj-place nil
-          ^(macrolet ((,deleter ()  ;; todo: place must not have optional val
-                       ^(rlet ((,',obj-sym (,',ogetter-sym))
-                               ,*(mapcar (ret ^(,@1 (sys:l1-val ,@2)))
-                                         ',arg-syms ',args))
-                          (let ((,',oldval-sym [,',obj-sym ,*',arg-syms]))
-                            (progn
-                              (,',osetter-sym
-                                (sys:dwim-del ,',obj-sym ,*',arg-syms))
-                              ,',oldval-sym)))))
-               ,body))))))
+        (if (place-form-p obj-place sys:*pl-env*)
+          (with-update-expander (ogetter-sym osetter-sym) obj-place nil
+            ^(macrolet ((,deleter ()
+                         ^(rlet ((,',obj-sym (,',ogetter-sym))
+                                 ,*(mapcar (ret ^(,@1 (sys:l1-val ,@2)))
+                                           ',arg-syms ',args))
+                            (let ((,',oldval-sym [,',obj-sym ,*',arg-syms]))
+                              (progn
+                                (,',osetter-sym
+                                  (sys:dwim-del t ,',obj-sym ,*',arg-syms))
+                                ,',oldval-sym)))))
+                 ,body))
+            ^(macrolet ((,deleter ()
+                         ^(rlet ((,',obj-sym ,',obj-place)
+                                 ,*(mapcar (ret ^(,@1 (sys:l1-val ,@2)))
+                                           ',arg-syms ',args))
+                            (let ((,',oldval-sym [,',obj-sym ,*',arg-syms]))
+                              (progn
+                                (sys:dwim-del nil ,',obj-sym ,*',arg-syms)
+                                ,',oldval-sym)))))
+                 ,body))))))
 
 (defplace (force promise) body
   (getter setter