From e04d1dafc700813c835ae4e45af4e104c49e8875 Mon Sep 17 00:00:00 2001 From: Earl Hyatt Date: Wed, 12 Mar 2025 23:01:49 -0400 Subject: [PATCH] Add cl-with-accessors * lisp/emacs-lisp/cl-macs.el (cl-with-accessors): New macro. * doc/misc/cl.texi (Structures): Mention the new macro. * test/lisp/emacs-lisp/cl-macs-tests.el (cl-lib-struct-with-accessors): New Test. * etc/NEWS (New macro 'cl-with-accessors'.): Mention the macro. This macro is useful when making repeated use of a structures accessor functions, such as reading from a slot and then writing to a slot. It is similar to 'with-slots' from EIEIO, but uses accessor functions instead of slot names. --- doc/misc/cl.texi | 49 +++++++++++++++++++++++++++ etc/NEWS | 10 ++++++ lisp/emacs-lisp/cl-macs.el | 44 ++++++++++++++++++++++++ test/lisp/emacs-lisp/cl-macs-tests.el | 15 ++++++++ 4 files changed, 118 insertions(+) diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index e51e245c736..7219494391b 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -4066,6 +4066,55 @@ A documentation string describing the slot. Other slot options are currently ignored. +@defmac cl-with-accessors name bindings body@dot{} +You can use @code{cl-with-accessors} to lexically define symbols as +expressions calling the given accessor functions on a single instance of +a structure or class defined by @code{cl-defstruct} or @code{defclass} +(@pxref{eieio}). This can simplify code that repeatedly accesses slots. +With it, you can use @code{setf} and @code{setq} on the symbols like +normal variables, modifying the values in the structure. Unlike the +macro @code{with-slots} (@pxref{Accessing Slots,,,eieio,EIEIO}), because +the symbol expands to a function call, @code{cl-with-accessors} can be +used with any generalized variable that can take a single argument, such +as @code{cl-first} and @code{cl-rest}. +@end defmac + +@example +;; Using accessors with long, clear names without the macro: +(defun internal-normalization (person) + "Correct the values of the slots in PERSON to be as expected." + ;; Check the values of the structure: + (when (equal (person-optional-secondary-data person) "") + (setf (person-optional-secondary-data person) nil)) + (when (null (person-access-settings person)) + (setf (person-access-settings person) 'default)) + (when (< (long-accessor-name-that-can-become-unreadable-when-repeated + person) + 9) + (cl-incf (long-accessor-name-that-can-become-unreadable-when-repeated + person) + 100)) + ;; And so on before returning the structure: + person) + +;; Using accessors with long, clear names with the macro: +(defun internal-normalization (person) + "Correct the values of the slots in PERSON to be as expected." + (cl-with-accessors ((secondary-data person-optional-secondary-data) + (access-settings person-access-settings) + (short-name person-much-longer-accessor-name)) + person + ;; Check the values of the structure: + (when (equal secondary-data "") + (setf secondary-data nil)) + (when (null access-settings) + (setf access-settings 'default)) + (when (< short-name 9) + (cl-incf short-name 100)) + ;; And so on before returning the structure: + person)) +@end example + For obscure historical reasons, structure options take a different form than slot options. A structure option is either a keyword symbol, or a list beginning with a keyword symbol possibly followed diff --git a/etc/NEWS b/etc/NEWS index afa45c5ca0d..8c65b195b1a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1611,6 +1611,16 @@ New faces have been added to 'icomplete-vertical-mode': - 'icomplete-vertical-unselected-prefix-indicator-face' controls the appearance of unselected candidate prefixes. +** CL-Lib + ++++ +*** New macro 'cl-with-accessors'. +This macro is similar to 'with-slots', but uses accessor functions +instead of slot names. It is useful when slots' accessor functions are +used repeatedly, such as reading from a slot and then writing to that +slot. Symbol macros are created for the accessor functions using +'cl-symbol-macrolet', so that they can be used with 'setq' and 'setf'. + ** Miscellaneous --- diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 960f2e6742b..cc1c6a6a5ad 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2576,6 +2576,50 @@ See also `macroexp-let2'." collect `(,(car name) ,gensym)) ,@body))))) +;;;###autoload +(defmacro cl-with-accessors (bindings instance &rest body) + "Use BINDINGS as function calls on INSTANCE inside BODY. + +This macro helps when writing code that makes repeated use of the +accessor functions of a structure or object instance, such as those +created by `cl-defstruct' and `defclass'. + +BINDINGS is a list of (NAME ACCESSOR) pairs. Inside BODY, NAME is +treated as the function call (ACCESSOR INSTANCE) using +`cl-symbol-macrolet'. NAME can be used with `setf' and `setq' as a +generalized variable. Because of how the accessor is used, +`cl-with-accessors' can be used with any generalized variable that can +take a single argument, such as `car' and `cdr'. + +See also the macro `with-slots' described in the Info +node `(eieio)Accessing Slots', which is similar, but uses slot names +instead of accessor functions. + +\(fn ((NAME ACCESSOR) ...) INSTANCE &rest BODY)" + (declare (debug [(&rest (symbolp symbolp)) form body]) + (indent 2)) + (cond ((null body) + (macroexp-warn-and-return "`cl-with-accessors' used with empty body" + nil 'empty-body)) + ((null bindings) + (macroexp-warn-and-return "`cl-with-accessors' used without accessors" + (macroexp-progn body) + 'suspicious)) + (t + (cl-once-only (instance) + (let ((symbol-macros)) + (dolist (b bindings) + (pcase b + (`(,(and (pred symbolp) var) + ,(and (pred symbolp) accessor)) + (push `(,var (,accessor ,instance)) + symbol-macros)) + (_ + (error "Malformed `cl-with-accessors' binding: %S" b)))) + `(cl-symbol-macrolet + ,symbol-macros + ,@body)))))) + ;;; Multiple values. ;;;###autoload diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index b4b939d3d31..ed6b1c2e4d4 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -541,6 +541,21 @@ collection clause." (should (mystruct-p (cl-lib--con-1))) (should (mystruct-p (cl-lib--con-2)))) +(ert-deftest cl-lib-struct-with-accessors () + (let ((x (make-mystruct :abc 1 :def 2))) + (cl-with-accessors ((abc mystruct-abc) + (def mystruct-def)) + x + (should (= abc 1)) + (should-error (setf abc 99)) + (should (= def 2)) + (setf def 3) + (should (= def 3)) + (setq def 4) + (should (= def 4))) + (should (= 4 (mystruct-def x))) + (should (= 1 (mystruct-abc x))))) + (ert-deftest cl-lib-arglist-performance () ;; An `&aux' should not cause lambda's arglist to be turned into an &rest ;; that's parsed by hand.