From def0dc98a2b68d4a34d5d6b2a098ba3260753e6b Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@jjgr-2.local>
Date: Mon, 27 Jul 2009 22:11:27 +0200
Subject: [PATCH] SETF produces simpler expansions for simple cases of DEFSETF

---
 src/CHANGELOG    |  3 +++
 src/lsp/setf.lsp | 33 ++++++++++++++++++++-------------
 2 files changed, 23 insertions(+), 13 deletions(-)

diff --git a/src/CHANGELOG b/src/CHANGELOG
index 2cf395a83..e330369cf 100644
--- a/src/CHANGELOG
+++ b/src/CHANGELOG
@@ -34,6 +34,9 @@ ECL 9.7.2:
    --output-encoding and --error-encoding, allow the user to change the 
    external formats of the default streams.
 
+ - For places defined with the simple form of DEFSETF, SETF now produces
+   a simpler expansion, without a surrounding LET* form.
+
 * Bugs fixed:
 
  - SI:GET-LIBRARY-PATHNAME did not work properly in Windows.
diff --git a/src/lsp/setf.lsp b/src/lsp/setf.lsp
index 9f72d8714..7ea680028 100644
--- a/src/lsp/setf.lsp
+++ b/src/lsp/setf.lsp
@@ -189,7 +189,7 @@ Does not check if the third gang is a single-element list."
 (defsetf fdefinition sys:fset)
 (defsetf macro-function (s &optional env) (v) `(sys:fset ,s ,v t))
 (defsetf aref (a &rest il) (v) `(sys:aset ,v ,a ,@il))
-(defsetf row-major-aref (a i) (v) `(sys:row-major-aset ,a ,i ,v))
+(defsetf row-major-aref sys:row-major-aset)
 (defsetf get (s p &optional d) (v)
   (if d `(progn ,d (sys:putprop ,s ,v ,p)) `(sys:putprop ,s ,v ,p)))
 (defsetf get-sysprop put-sysprop)
@@ -202,13 +202,13 @@ Does not check if the third gang is a single-element list."
 (defsetf symbol-plist sys:set-symbol-plist)
 (defsetf gethash (k h &optional d) (v) `(sys:hash-set ,k ,h ,v))
 #-clos
-(defsetf documentation (s d) (v) `(sys::set-documentation ,s ,d ,v))
+(defsetf documentation sys::set-documentation)
 #+clos
 (defsetf sys:instance-ref sys:instance-set)
 (defsetf compiler-macro-function (fname) (function)
   `(sys::put-sysprop ,fname 'sys::compiler-macro ,function))
 (defsetf readtable-case sys:readtable-case-set)
-
+(defsetf stream-external-format sys::stream-external-format-set)
 
 (define-setf-expander getf (&environment env place indicator &optional default)
   (multiple-value-bind (vars vals stores store-form access-form)
@@ -303,16 +303,23 @@ Does not check if the third gang is a single-element list."
       (get-setf-expansion place env)
     (declare (ignore access-form))
     (let ((declaration `(declare (:read-only ,@(append vars stores)))))
-      (if (= (length stores) 1)
-	`(let* ,(mapcar #'list
-			(append vars stores)
-			(append vals (list newvalue)))
-	  ,declaration
-	  ,store-form)
-	`(let* ,(mapcar #'list vars vals)
-	  (multiple-value-bind ,stores ,newvalue
-	    ,declaration
-	    ,store-form))))))
+      (cond ((and (consp place)
+                  (let* ((name (first place))
+                         (inverse (get-sysprop name 'setf-update-fn)))
+                    (and inverse
+                         (consp store-form)
+                         (eq inverse (first store-form))
+                         `(,inverse ,@(rest place) ,newvalue)))))
+            ((= (length stores) 1)
+             `(let* ,(mapcar #'list
+                             (append vars stores)
+                             (append vals (list newvalue)))
+                ,declaration
+                ,store-form))
+            (t `(let* ,(mapcar #'list vars vals)
+                  (multiple-value-bind ,stores ,newvalue
+                    ,declaration
+                    ,store-form)))))))
 
 (defun setf-structure-access (struct type index newvalue)
   (declare (si::c-local))