From d553e603f405acb06ad9ea233543ebe6ce319210 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 31 Oct 2021 10:57:44 -0400 Subject: [PATCH] eieio-core.el: Make slot-value work on defstructs Adjust the values in EIEIO's index-tables so they are compatible with those of defstructs. * lisp/emacs-lisp/eieio-core.el (eieio--slot-name-index): Don't add the `eieio--object-num-slots` offset. (eieio-defclass-internal): Add the `eieio--object-num-slots` offset here instead. (eieio-oref): Allow its use on `cl-structure-object`. * lisp/emacs-lisp/eieio.el (eieio-pcase-slot-index-from-index-table): Don't need to add the `eieio--object-num-slots` offset. * doc/misc/eieio.texi (Accessing Slots, Accessing Slots): Mention the use on structs. * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el (eieio-test-defstruct-slot-value): New test. --- doc/misc/eieio.texi | 9 +++++---- etc/NEWS | 4 ++++ lisp/emacs-lisp/eieio-core.el | 10 ++++++---- lisp/emacs-lisp/eieio.el | 4 +--- test/lisp/emacs-lisp/eieio-tests/eieio-tests.el | 12 ++++++++++++ 5 files changed, 28 insertions(+), 11 deletions(-) diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi index 63b42827311..2b0b1f7fd67 100644 --- a/doc/misc/eieio.texi +++ b/doc/misc/eieio.texi @@ -700,18 +700,19 @@ slot values, and use the previously mentioned set/ref routines. @defun slot-value object slot @anchor{slot-value} This function retrieves the value of @var{slot} from @var{object}. +It can also be used on objects defined by @code{cl-defstruct}. This is a generalized variable that can be used with @code{setf} to -modify the value stored in @var{slot}. @xref{Generalized -Variables,,,elisp,GNU Emacs Lisp Reference Manual}. +modify the value stored in @var{slot}, tho not for objects defined by +@code{cl-defstruct}. +@xref{Generalized Variables,,,elisp,GNU Emacs Lisp Reference Manual}. @end defun @defun set-slot-value object slot value @anchor{set-slot-value} This function sets the value of @var{slot} from @var{object}. -This is not a CLOS function, but is the obsolete setter for -@code{slot-value} used by the @code{setf} macro. It is therefore +This is not a CLOS function. It is therefore recommended to use @w{@code{(setf (slot-value @var{object} @var{slot}) @var{value})}} instead. @end defun diff --git a/etc/NEWS b/etc/NEWS index 7f1fa8b8f4d..3e26a015503 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -132,6 +132,10 @@ change the terminal used on a remote host. * Changes in Specialized Modes and Packages in Emacs 29.1 +** EIEIO ++++ +*** 'slot-value' can now be used to read slots of 'cl-defstruct' objects + ** align --- diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 80d1711d817..7c5babcf54c 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -478,7 +478,8 @@ See `defclass' for more information." ;; (dotimes (cnt (length cslots)) ;; (setf (gethash (cl--slot-descriptor-name (aref cslots cnt)) oa) (- -1 cnt))) (dotimes (cnt (length slots)) - (setf (gethash (cl--slot-descriptor-name (aref slots cnt)) oa) cnt)) + (setf (gethash (cl--slot-descriptor-name (aref slots cnt)) oa) + (+ (eval-when-compile eieio--object-num-slots) cnt))) (setf (eieio--class-index-table newc) oa)) ;; Set up a specialized doc string. @@ -508,6 +509,7 @@ See `defclass' for more information." ;; Create the cached default object. (let ((cache (make-record newc (+ (length (eieio--class-slots newc)) + ;; FIXME: Why +1 -1 ? (eval-when-compile eieio--object-num-slots) -1) nil))) @@ -747,7 +749,7 @@ Argument FN is the function calling this verifier." (_ exp)))) (gv-setter eieio-oset)) (cl-check-type slot symbol) - (cl-check-type obj (or eieio-object class)) + (cl-check-type obj (or eieio-object class cl-structure-object)) (let* ((class (cond ((symbolp obj) (error "eieio-oref called on a class: %s" obj) (eieio--full-class-object obj)) @@ -763,7 +765,7 @@ Argument FN is the function calling this verifier." ;; to intercept missing slot definitions. Since it is also the LAST ;; thing called in this fn, its return value would be retrieved. (slot-missing obj slot 'oref)) - (cl-check-type obj eieio-object) + (cl-check-type obj (or eieio-object cl-structure-object)) (eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref)))) @@ -892,7 +894,7 @@ reverse-lookup that name, and recurse with the associated slot value." ;; Removed checks to outside this call (let* ((fsi (gethash slot (eieio--class-index-table class)))) (if (integerp fsi) - (+ (eval-when-compile eieio--object-num-slots) fsi) + fsi (let ((fn (eieio--initarg-to-attribute class slot))) (if fn ;; Accessing a slot via its :initarg is accepted by EIEIO diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 3d73e5fef7b..3fbfe011e29 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -359,9 +359,7 @@ variable name of the same name as the slot." (defun eieio-pcase-slot-index-from-index-table (index-table slot) "Find the index to pass to `aref' to access SLOT." - (let ((index (gethash slot index-table))) - (if index (+ (eval-when-compile eieio--object-num-slots) - index)))) + (gethash slot index-table)) (pcase-defmacro eieio (&rest fields) "Pcase patterns that match EIEIO object EXPVAL. diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index 9eb7fb02230..ba2e5f7be4a 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -969,6 +969,18 @@ Subclasses to override slot attributes.") (should (eieio-instance-inheritor-slot-boundp C :b)) (should-not (eieio-instance-inheritor-slot-boundp C :c)))) +;;;; Interaction with defstruct + +(cl-defstruct eieio-test--struct a b c) + +(ert-deftest eieio-test-defstruct-slot-value () + (let ((x (make-eieio-test--struct :a 'A :b 'B :c 'C))) + (should (eq (eieio-test--struct-a x) + (slot-value x 'a))) + (should (eq (eieio-test--struct-b x) + (slot-value x 'b))) + (should (eq (eieio-test--struct-c x) + (slot-value x 'c))))) (provide 'eieio-tests) -- 2.39.2