bug#11970: EIEIO accessors no longer work with setf in Emacs HEAD

[Stefan Monnier]

>     (defclass foo nil
>       ((bar :initarg :bar :accessor bar :initform nil)))
[...]
>     (setf (bar *foo*) :quz)
>     ;; => (error "(bar *foo*) is not a valid place expression")

Indeed, I had not noticed that eieio.el relied on cl-macs.el's internals
for these.  Should be fixed now, thank you.


        Stefan


=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog      2012-07-18 05:44:36 +0000
+++ lisp/ChangeLog      2012-07-18 07:18:25 +0000
@@ -1,3 +1,8 @@
+2012-07-18  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * emacs-lisp/eieio.el: Adapt further to gv.el (bug#11970).
+       (eieio-defclass): Use gv-define-setter when possible.
+
 2012-07-18  Dmitry Antipov  <dmantipov@yandex.ru>
 
        Reflect recent changes in Fgarbage_collect.

=== modified file 'lisp/emacs-lisp/eieio.el'
--- lisp/emacs-lisp/eieio.el    2012-07-13 07:06:09 +0000
+++ lisp/emacs-lisp/eieio.el    2012-07-18 07:10:56 +0000
@@ -44,8 +44,7 @@
 
 ;;; Code:
 
-(eval-when-compile
-  (require 'cl))
+(eval-when-compile (require 'cl))       ;FIXME: Use cl-lib!
 
 (defvar eieio-version "1.3"
   "Current version of EIEIO.")
@@ -431,10 +430,10 @@
   (run-hooks 'eieio-hook)
   (setq eieio-hook nil)
 
-  (if (not (symbolp cname)) (signal 'wrong-type-argument '(symbolp cname)))
-  (if (not (listp superclasses)) (signal 'wrong-type-argument '(listp 
superclasses)))
+  (if (not (listp superclasses))
+      (signal 'wrong-type-argument '(listp superclasses)))
 
-  (let* ((pname (if superclasses superclasses nil))
+  (let* ((pname superclasses)
         (newc (make-vector class-num-slots nil))
         (oldc (when (class-p cname) (class-v cname)))
         (groups nil) ;; list of groups id'd from slots
@@ -553,8 +552,8 @@
       (put cname 'cl-deftype-handler
           (list 'lambda () `(list 'satisfies (quote ,csym)))))
 
-    ;; before adding new slots, let's add all the methods and classes
-    ;; in from the parent class
+    ;; Before adding new slots, let's add all the methods and classes
+    ;; in from the parent class.
     (eieio-copy-parents-into-subclass newc superclasses)
 
     ;; Store the new class vector definition into the symbol.  We need to
@@ -652,9 +651,9 @@
        ;; We need to id the group, and store them in a group list attribute.
        (mapc (lambda (cg) (add-to-list 'groups cg)) customg)
 
-       ;; anyone can have an accessor function.  This creates a function
+       ;; Anyone can have an accessor function.  This creates a function
        ;; of the specified name, and also performs a `defsetf' if applicable
-       ;; so that users can `setf' the space returned by this function
+       ;; so that users can `setf' the space returned by this function.
        (if acces
            (progn
              (eieio--defmethod
@@ -668,6 +667,13 @@
                            ;; Else - Some error?  nil?
                            nil)))
 
+              (if (fboundp 'gv-define-setter)
+                  ;; FIXME: We should move more of eieio-defclass into the
+                  ;; defclass macro so we don't have to use `eval' and require
+                  ;; `gv' at run-time.
+                  (eval `(gv-define-setter ,acces (eieio--store eieio--object)
+                           (list 'eieio-oset eieio--object '',name
+                                 eieio--store)))
              ;; Provide a setf method.  It would be cleaner to use
              ;; defsetf, but that would require CL at runtime.
              (put acces 'setf-method
@@ -678,8 +684,9 @@
                         (list --widget-sym--)
                         (list widget)
                         (list --store-sym--)
-                        (list 'eieio-oset --widget-sym-- '',name --store-sym--)
-                        (list 'getfoo --widget-sym--)))))))
+                           (list 'eieio-oset --widget-sym-- '',name
+                                 --store-sym--)
+                           (list 'getfoo --widget-sym--))))))))
 
        ;; If a writer is defined, then create a generic method of that
        ;; name whose purpose is to set the value of the slot.
@@ -702,7 +709,8 @@
        )
       (setq slots (cdr slots)))
 
-    ;; Now that everything has been loaded up, all our lists are backwards!  
Fix that up now.
+    ;; Now that everything has been loaded up, all our lists are backwards!
+    ;; Fix that up now.
     (aset newc class-public-a (nreverse (aref newc class-public-a)))
     (aset newc class-public-d (nreverse (aref newc class-public-d)))
     (aset newc class-public-doc (nreverse (aref newc class-public-doc)))
@@ -2544,11 +2552,14 @@
 ;;
 
 (defsetf eieio-oref eieio-oset)
-;; FIXME: Not needed for Emacs>=24.2 since setf follows function aliases.
+
+(if (eval-when-compile (fboundp 'gv-define-expander))
+    ;; Not needed for Emacs>=24.2 since gv.el's setf expands macros and
+    ;; follows aliases.
+    nil
 (defsetf slot-value eieio-oset)
 
 ;; The below setf method was written by Arnd Kohrs <kohrs@acm.org>
-;; FIXME: Not needed for Emacs>=24.2 since setf expands macros.
 (define-setf-method oref (obj slot)
   (with-no-warnings
     (require 'cl)
@@ -2560,7 +2571,7 @@
            (list store-temp)
            (list 'set-slot-value obj-temp slot-temp
                  store-temp)
-           (list 'slot-value obj-temp slot-temp)))))
+           (list 'slot-value obj-temp slot-temp))))))
 
 
 ;;;