defset: eliminate the get-form argument.

* share/txr/stdlib/defset.tl (defset-expander): Drop getform
argument. Obtain the arguments of the place in a variable
called args, which is then explicitly destructured with
tree-case to match the params list. Having all of the original
arguments in args, we can work backwards to replace some of
them with gensyms. The resulting gensym-ized list is used
to generate the access call to the operator named by name.

* txr.1: Update doc to get rid of get-form. Updated and
corrected the long form example.

2 files changed, 79 insertions, 64 deletions

diff --git a/share/txr/stdlib/defset.tl b/share/txr/stdlib/defset.tl
index 521260ba..f9e77fa7 100644
--- a/share/txr/stdlib/defset.tl
+++ b/share/txr/stdlib/defset.tl
@@ -55,7 +55,7 @@
                           (,,setter (val) ^(,',',set-fun ,*',pgens ,val)))
                  ,body)))))))
 
-(defun defset-expander (env macform name params newval getform setform)
+(defun defset-expander (env macform name params newval setform)
   (let* ((ap (analyze-params params))
          (exp-params (car ap))
          (total-syms (cadr ap))
@@ -64,35 +64,42 @@
          (restpar (if (symbol-package fp.rest) fp.rest))
          (extsyms [keep-if symbol-package
                            (diff total-syms (cons restpar fixpars))]))
-    (with-gensyms (getter setter)
-      ^(defplace (,name ,*params) body
+    (with-gensyms (getter setter args)
+      ^(defplace (,name . ,args) body
          (,getter ,setter
-            (let* ((gpf-pairs (mapcar (op list (gensym)) (list ,*fixpars)))
-                   (gpr-pairs (if ',restpar
-                                (if (consp ,restpar)
-                                  (mapcar (op list (gensym)) ,restpar)
-                                  (list (list (gensym) ,restpar)))))
-                   (ext-pairs (mapcar (op list (gensym)) (list ,*extsyms)))
-                   (pgens [mapcar car gpf-pairs])
-                   (rgens [mapcar car gpr-pairs])
-                   (egens [mapcar car ext-pairs]))
-              ^(alet (,*gpf-pairs ,*gpr-pairs ,*ext-pairs)
-                 ,(expand ^(symacrolet (,*(zip ',fixpars
-                                               (mapcar (ret ^',@1) pgens))
-                                        ,*(zip ',extsyms
-                                               (mapcar (ret ^',@1) egens))
-                                        ,*(if gpr-pairs
-                                            (if (consp ,restpar)
-                                              ^((,',restpar ',rgens))
-                                              ^((,',restpar ',(car rgens))))))
-                             (macrolet ((,,getter () ,',getform)
-                                        (,,setter (,',newval) ,',setform))
-                               ,body))
-                          ,env))))))))
+           (tree-bind (,*params) ,args
+             (let* ((gpf-pairs (mapcar (op list (gensym)) (list ,*fixpars)))
+                    (gpr-pairs (if ',restpar
+                                 (if (consp ,restpar)
+                                   (mapcar (op list (gensym)) ,restpar)
+                                   (list (list (gensym) ,restpar)))))
+                    (ext-pairs (mapcar (op list (gensym)) (list ,*extsyms)))
+                    (pgens [mapcar car gpf-pairs])
+                    (rgens [mapcar car gpr-pairs])
+                    (egens [mapcar car ext-pairs])
+                    (all-pairs (append gpf-pairs gpr-pairs ext-pairs))
+                    (agens (collect-each ((a ,args))
+                             (let ((p [pos a all-pairs eq cadr]))
+                               (if p
+                                 (car (del [all-pairs p]))
+                                 a)))))
+               ^(alet (,*gpf-pairs ,*gpr-pairs ,*ext-pairs)
+                  ,(expand ^(symacrolet (,*(zip ',fixpars
+                                                (mapcar (ret ^',@1) pgens))
+                                         ,*(zip ',extsyms
+                                                (mapcar (ret ^',@1) egens))
+                                         ,*(if gpr-pairs
+                                             (if (consp ,restpar)
+                                               ^((,',restpar ',rgens))
+                                               ^((,',restpar ',(car rgens))))))
+                              (macrolet ((,,getter () ^(,',',name ,',*agens))
+                                         (,,setter (,',newval) ,',setform))
+                                ,body))
+                           ,env)))))))))
 
 (defmacro usr:defset (:env e :form mf . args)
   (tree-case args
-    ((name (. params) newval getform setform)
+    ((name (. params) newval setform)
      (defset-expander e mf . args))
     ((get-fun set-fun)
      (defset-expander-simple mf get-fun set-fun))
diff --git a/txr.1 b/txr.1
index 3115d465..3d47d884 100644
--- a/txr.1
+++ b/txr.1
@@ -34500,7 +34500,7 @@ cells:
 
 .coNP Macro @ defset
 .synb
-.mets (defset < name < params < new-val-sym < get-form << set-form )
+.mets (defset < name < params < new-val-sym << set-form )
 .mets (defset < get-fun-sym << set-fun-sym )
 .syne
 .desc
@@ -34544,11 +34544,9 @@ only, which should ensure that the expression that
 holds is evaluated only once.
 
 The
-.meta get-form
-and
 .meta set-form
-arguments specify forms which generate the code for, respectively,
-accessing the value of the place, and storing a new value.
+argument specifies an expression which generates the code for storing a new
+value to the place.
 
 The
 .code defset
@@ -34566,16 +34564,24 @@ syntax. Code is also generated to evaluate the expression which gives the
 new value to be stored, and that is bound to a generated variable whose
 name is bound to the
 .code new-val-sym
-symbol. Then arrangements are made to invoke the
-.code get-form
-and
+symbol. Then arrangements are made to invoke the operator named by
+.meta name
+and to evaluate the
+.code set-form
+in an environment in which these symbol bindings are visible.
+The operator named
+.meta name
+is invoked using an altered argument list which uses temporary symbols in place
+of the original expressions. The task of
 .code set-form
-in an environment in which these symbol bindings are visible. The task of
-these forms is to insert the values of the symbols from
+is to insert the values of the symbols from
 .meta params
 and
 .meta new-val-sym
-into suitable code templates that will perform the access and store actions.
+into a suitable code templates that will perform the store actions.
+The code generated by
+.code set-form
+must also take on the responsibility of yielding the new value as its result.
 
 If
 .meta params
@@ -34631,8 +34637,6 @@ a temporary variable which holds the value of
 rather than to a list of temporary variable names holding the values
 of trailing expressions.
 The
-.code get-form
-and
 .code set-form
 must be prepared for this situation. In particular, the rest parameter's value
 is an atom, then it cannot be spliced in the backquote syntax, except at the
@@ -34651,8 +34655,6 @@ the parameter expansion is applied at the time the
 .code defset
 form is processed, specifying an expanded parameter list which
 receives unevaluated expressions. The
-.meta get-form
-and
 .meta set-form
 may refer to all symbols produced by parameter list expansion, other
 than generated symbols. For instance, if a parameter list macro
@@ -34668,8 +34670,6 @@ list of a
 then
 .code x
 will be visible to the
-.meta get-form
-and
 .metn set-form .
 
 The short, two-argument form of
@@ -34733,21 +34733,20 @@ as a syntactic place using a long form
 
 .cblk
   (defset car (cell) new
-    ^(car ,cell)
     (let ((n (gensym)))
       ^(rlet ((,n ,new))
          (progn (rplaca ,cell ,n) ,n))))
 .cble
 
 Given such a definition, the expression
-.code "(inc (car abc))"
+.code "(inc (car (abc)))"
 expands to code closely resembling:
 
 .cblk
-  (let ((#:g0014 (abc)))
-    (let ((#:g0028 (succ (car #:g0014))))
-        (rplaca #:g0014 #:g0028)
-            #:g0028))
+  (let ((#:g0048 (abc)))
+    (let ((#:g0050 (succ (car #:g0048))))
+      (rplaca #:g0048 #:g0050)
+      #:g0050))
 .cble
 
 The
@@ -34757,7 +34756,7 @@ macro has arranged for the argument expression
 of
 .code car
 to be evaluated to a temporary variable
-.codn #:g0014 ,
+.codn #:g0048 ,
 a
 .codn gensym .
 This, then, holds the
@@ -34767,38 +34766,47 @@ At macro-expansion time, the variable
 .code cell
 from the parameter list specified by the
 .code defset
-is bound to this symbol. The subexpression
-.code "(car #:0014)"
-is derived from the
-.meta get-form
-.code "^(car ,cell)"
-which inserted the value of
-.code cell
-into a backquote template, that value being the symbol
-.codn #:g0014 .
+is bound to this symbol. The access expression
+.code "(car #:0048)"
+to retrieve the prior value is automatically generated
+by combining the name of the place
+.code car
+with the gensym to which its argument
+.code (abc)
+has been evaluated.
 The
 .code new
 variable was bound to the expression giving the new value, namely
-.codn "(succ (car #:g0014))" .
+.codn "(succ (car #:g0048))" .
 The
 .meta set-form
 is careful to evaluate this only one time, storing its value into
 the temporary variable
-.codn #:g0028 ,
+.codn #:g0050 ,
 referenced by the variable
 .codn n .
 The
 .metn set-form 's
 .code "(rplaca ,cell ,n)"
 fragment thus turned into
-.code "(rplaca #:g0014 #:g0028)"
+.code "(rplaca #:g0048 #:g0050)"
 where
-.code #:g0014
+.code #:g0048
 references the cons cell being operated on, and
-.code #:g0028
+.code #:g0050
 the calculated new value to be stored into its
 .code car
 field.
+The
+.meta set-form
+is careful to arrange for the new value
+.code #:g0050
+to be returned. Those place-mutating operators which yield the new value, such
+as
+.code set
+and
+.code inc
+rely on this behavior.
 
 .coNP Macro @ define-place-macro
 .synb