Subject: Re: bug#77058: [PATCH] Add cl-with-accessors

From: Daniel Colascione <[email-masked]>
Date: Sat, 29 Mar 2025 11:59:57 -0400

Eli Zaretskii <[email-masked]> writes:

> Ping! Okamsn, would you like to submit an updated patch?
>
>> Cc: [email-masked]
>> Date: Tue, 18 Mar 2025 12:19:56 -0400
>> From:  Stefan Monnier via "Bug reports for GNU Emacs,
>>  the Swiss army knife of text editors" <[email-masked]>
>> 
>> > The attached patch adds the macro `cl-with-accessors'.  This macro uses 
>> > `cl-symbol-macrolet' to treat a symbol like a use of an accessor 
>> > function, such as those made by `cl-defstruct' and `cl-defclass'. This 
>> > can be helpful when using repeated calls to read and write with the 
>> > functions.
>> 
>> Thanks.  See comments below.
>> 
>> > Also, in the test `cl-lib-struct-accessors' in 
>> > test/lisp/emacs-lisp/cl-lib-tests.el, it checks for the keyword 
>> > `:readonly', but the documented keyword is `:read-only'.  Is this a 
>> > typo, or was this intentional?
>> 
>> I'd go with "typo".
>> 
>> > --- a/doc/misc/cl.texi
>> > +++ b/doc/misc/cl.texi
>> > @@ -4225,6 +4225,19 @@ Structures
>> >  
>> >  Other slot options are currently ignored.
>> >  
>> > +The macro @code{cl-with-accessors} can simplify code that repeatedly
>> > +accesses slots.
>> > +
>> > +@example
>> > +(defun add-one-year (person)
>> > +  (cl-with-accessors ((age person-age))
>> > +      person
>> > +    (if (null age)
>> > +        (error "Age is missing")
>> > +      (cl-incf age)))
>> > +  person)
>> > +@end example
>> 
>> It'd be worthwhile to mention that it also works with accessors of other
>> objects than structs, e.g. `car`, or `process-filter`.
>> 
>> Of course, any EIEIO user would rewrite the above to:
>> 
>>     (defun add-one-year (person)
>>       (with-slots (age) person
>>         (if (null age)
>>             (error "Age is missing")
>>           (cl-incf age)))
>>       person)
>> 
>> so maybe it's worth mentioning `with-slots` (which arguably should be
>> moved to `cl-lib`).
>> 
>> > --- a/etc/NEWS
>> > +++ b/etc/NEWS
>> > @@ -2496,6 +2496,13 @@ This function is like 'type-of' except that it sometimes returns
>> >  a more precise type.  For example, for nil and t it returns 'null'
>> >  and 'boolean' respectively, instead of just 'symbol'.
>> >  
>> > +** New macro 'cl-with-accessors'
>> > +This macro is similar to 'map-let', but works with structures and their
>> > +accessors functions.  It is useful when slots' accessor functions are
>> > +use 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'.
>> 
>> I think this should be moved to a CL-Lib subsection in the
>> "package-specific changes" section.
>> 
>> > +;;;###autoload
>> > +(defmacro cl-with-accessors (bindings instance &rest body)
>> > +  "Generate code using symbols as accessing expressions for 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'.
>> > +
>> > +Inside BODY, SYMBOL-NAME is treated as the function call (ACCESSOR-NAME
>> > +INSTANCE) using `cl-symbol-macrolet'.  SYMBOL-NAME can be used with
>> > +`setf' and `setq' as a generalized variable.
>> 
>> I'd use `VAR` or `SYMBOL` rather than `SYMBOL-NAME`.
>> Probably similarly use `ACCESSOR` rather than `ACCESSOR-NAME`.
>> 
>> > +\(fn ((SYMBOL-NAME ACCESSOR-NAME) ...) INSTANCE &REST BODY)"
>> 
>> Should be lower case `&rest` on this last line.
>> 
>> > +  (declare (debug [(&rest (symbolp place)) form body])
>> > +           (indent 2))
>> 
>> I think `place` is wrong here.  `(person-age FOO)` is a "place" but
>> `person-age` is not (or, well, it is but not the right one: when taken
>> as a place it refers to the variable, not the accessor).
>> I think it should just be `symbolp`.
>> 
>> > +  (cond ((null body)
>> > +         (macroexp-warn-and-return "No body given" nil 'empty-body))
>> 
>> Please use the same format as other similar warnings we have, such as:
>> 
>>     (format-message "`unless' with empty body")
>> 
>> 
>> - Stefan

Cool patch!

I really hate repeating myself in code, so I've been working with a
variant of the idea.  It looks like this:

    (cl-defmacro jr2-with-slots
        ((prefix object &optional (class nil class-specified))
         &rest body)
      "Convenience macro for field access.
    In (jr2-with-slots (OBJECT TYPE) BODY..)

    Make OBJECT->[SLOT] available in BODY as a generic place referencing
    SLOT in OBJECT, which must be a symbol and evaluate to an object of type
    TYPE, which must be a `defclass'-ed class name.

    The definition of TYPE must be visible to the compiler and so must be
    evaluated at both compile time and run time.  Use the `jr2-defclass'
    macro to automatically make the class definition
    available appropriately.

    For example:

      (jr2-defclass my-class () ((foo) (bar)))
      (cl-defmethod initialize-instance :around
          ((this my-class) &optional _slots)
          (jr2-with-slots (this my-class)
            (+ this->foo this->bar)))

    In this specific case, though, prefer writing (jr2-defmethod ...), which
    automatically adds a `jr2-with-slots'.

    Within the lexical scope of BODY, the special forms (boundp*
    OBJECT->[SLOT]) and (makunbound* OBJECT->[SLOT]) refer to EIEIO
    slot-boundedness of SLOT in OBJECT.

    Instead of (OBJECT TYPE), you can write (PREFIX OBJECT TYPE), in which
    case the slot access symbols are PREFIX[SLOT] and OBJECT need not be
    a symbol.  For example:

      (jr2-with-slots (foo-> (get-foo) my-foo) foo->field)

    \(fn (OBJECT TYPE) &rest BODY)"
      (declare (indent 1)
               (debug (jr2--with-slots-spec body)))
      (unless class-specified
        (cl-psetf
         prefix (intern (format "%s->" (cl-the symbol prefix)))
         object prefix
         class object))
      (unless (class-p class)
        (signal 'wrong-type-argument
                (list (format
                       (concat
                        "%s is not a class: did you forget to make it "
                        "available at compile time, e.g. by writing it with "
                        "`jr2-defclass' or wrapping it with `eval-and-compile'?")
                       class))))
      (let* ((slot-info
              (cl-loop
                    for slot in (eieio-class-slots class)
                    for slot-name = (eieio-slot-descriptor-name slot)
                    for accessor-name =
                    (intern (concat (symbol-name prefix) (symbol-name slot-name)))
                    collect `(,accessor-name ,slot-name)))
             ;; Generate helpful symbol name for cl-assert
             (object-sym (gensym
                          (if (symbolp object)
                              (format "#%s#" object) "jr2--object"))))
        `(cl-macrolet ((boundp* (form)
                        (jr2--rewrite-slot-access 'slot-boundp form))
                       (makunbound* (form)
                        (jr2--rewrite-slot-access 'slot-makeunbound form)))
          (cl-symbol-macrolet
              ,(cl-loop
                     for (accessor-name slot-name) in slot-info
                     collect `(,accessor-name (slot-value ,object-sym ',slot-name)))
            (let ((,object-sym ,object))
              (cl-check-type ,object-sym ,class)
              ,@body)))))

    (cl-defmacro jr2-with-slots* (specs &rest body)
      "Like `jr2-with-slots' but with a list of specifications instead of
    just one."
      (declare (indent 1) (debug (([&rest jr2--with-slots-spec]) def-body)))
      (if (null specs)
          (macroexp-progn body)
        `(jr2-with-slots ,(car specs)
          (jr2-with-slots*  ,(cdr specs) ,@body))))

    (eval-and-compile
      (defun jr2--extract-kw-arg-names (kw-args)
        (cl-loop
              for arg in kw-args
              if (memq arg '(&allow-other-keys)) do (ignore arg)
              else if (and (symbolp arg) (string-prefix-p "&" (symbol-name arg)))
              do (error "unknown &-directive %S" arg)
              else collect (intern (concat ":"
                                           (symbol-name
                                            (cl-the (and symbol (not null))
                                              (or (car-safe arg) arg))))))))

I have various other macros that work with the system, e.g. a
jr2-defmethod.  Overall effect is you can write code like this:

  (jr2-defclass my-class () (a :type integer))                
  ...
  (jr2-defmethod my-method ((this my-class) b)
    (+ this->a b))

Look ma, no repetition!

Now, I realize the arrow syntax isn't everyone's cup of tea, but it's
legible and concise --- moreso than oref IMHO.  You could get away from
the need for compile-time visible of classes by switching from
cl-symbol-macrolet to a custom expander function (which is how
cl-symbol-macrolet itself is implemented), but I was too lazy.