lambda-set method: treat [struct ...] as place.

* eval.c (eval_init): Change registration of dwim-set to only
one required argument, with the rest variadic.

* lib.c (lambda_set_s): New symbol variable.
(dwim_set): Change to variadic function that takes all
arguments other than the object/sequence being operated on as
struct args *. Rewrite to do a test on the object type first,
handling hashes and structs specially.
(obj_init): Initialize lambda_set_s.

* share/txr/stdlib/place.tl (defplace dwim): Rewritten for
more generic syntax. The only argument required is obj-place;
the other arguments are treated as a variable argument list,
all treated uniformly.  This eliminates the special handling
of the default value for hash lookups.

* args.h (args_count): New inline function.

* txr.1: Updated documentation for dwim operator, which neglects
to mention use over objects thanks to the lambda function.
Documented lambda-set.

1 files changed, 24 insertions, 32 deletions

diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl
index d5fdf778..eaf6bda6 100644
--- a/share/txr/stdlib/place.tl
+++ b/share/txr/stdlib/place.tl
@@ -654,61 +654,53 @@
                   ^(set-hash-userdata ,',hash ,val)))
       ,body)))
 
-(defplace (dwim obj-place index : (default nil have-default-p) :env env) body
+(defplace (dwim obj-place :env env . args) body
   (getter setter
-    (with-gensyms (ogetter-sym osetter-sym obj-sym
-                   index-sym dflval-sym newval-sym)
-      (let ((sys:*lisp1* t))
+    (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))
-                  (,index-sym (sys:l1-val ,index))
-                  ,*(if have-default-p
-                      ^((,dflval-sym (sys:l1-val ,default)))))
+                  ,*(mapcar (ret ^(,@1 (sys:l1-val ,@2))) arg-syms args))
              (macrolet ((,getter ()
-                         '[,obj-sym ,index-sym
-                                    ,*(if have-default-p ^(,dflval-sym))])
+                          '[,obj-sym ,*arg-syms])
                         (,setter (val)
-                           ^(rlet ((,',newval-sym ,val))
-                              (,',osetter-sym
-                                (sys:dwim-set ,',obj-sym
-                                              ,',index-sym ,',newval-sym))
-                              ,',newval-sym)))
+                          ^(rlet ((,',newval-sym ,val))
+                             (,',osetter-sym
+                               (sys:dwim-set ,',obj-sym
+                                             ,*',arg-syms ,',newval-sym))
+                             ,',newval-sym)))
                ,body))))))
   (ssetter
-    (with-gensyms (osetter-sym ogetter-sym
-                   obj-sym newval-sym index-sym)
-      (let ((sys:*lisp1* t))
+    (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
           ^(macrolet ((,ssetter (val)
                        ^(rlet ((,',obj-sym (,',ogetter-sym))
-                               (,',index-sym (sys:l1-val ,',index))
+                               ,*(mapcar (ret ^(,@1 (sys:l1-val ,@2)))
+                                         ',arg-syms ',args)
                                (,',newval-sym ,val))
                           (,',osetter-sym
                             (sys:dwim-set ,',obj-sym
-                                          ,*(if ,have-default-p
-                                              ^((prog1
-                                                  ,',index-sym
-                                                  (sys:l1-val ,',default)))
-                                              ^(,',index-sym))
+                                          ,*',arg-syms
                                           ,',newval-sym))
                           ,',newval-sym)))
                ,body)))))
 
   (deleter
-    (with-gensyms (osetter-sym ogetter-sym
-                   obj-sym index-sym oldval-sym)
-      (let ((sys:*lisp1* t))
+    (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))
-                               (,',index-sym (sys:l1-val ,',index)))
-                          (let ((,',oldval-sym [,',obj-sym
-                                                ,',index-sym
-                                                ,*(if ,have-default-p
-                                                    ^(,',default))]))
+                               ,*(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 ,',index-sym))
+                                (sys:dwim-del ,',obj-sym ,*',arg-syms))
                               ,',oldval-sym)))))
                ,body))))))