Subject: Re: bug#72344: [PATCH] Add a version of cl-once-only which handles lists of forms

From: Thuna <[email-masked]>
Date: Wed, 14 Aug 2024 04:21:32 +0200

> You're not keen on either of my other suggestions, right?
>
>     cl-once-only-many, cl-once-only-these

No, I am really *really* not that enthusiastic about either of those
names.  `*-these' is completely out of the question, and `*-many'
is... fine, but IMO sounds worse than `*-multiple'.

> I guess I am hung up on how -multiple- is already used in CL names,
> but it comes *before* the things that are multiple.  But I believe you
> don't like cl-multiple-once-only.

`multiple' seems to be used exclusively in `cl-multiple-value-*' names,
so there is some possibility that this might maybe be confused as a part
of that suite, but I don't think it's a particularly significant one.

> The interdiff isn't too helpful to me here.  I'd prefer to review a
> complete patch against master.

Oops, sorry for the bad patch, I've attached the full diff.

diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 113029700ec..de9f0565d03 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -999,7 +999,7 @@ Control Structure
 * Iteration::              @code{cl-do}, @code{cl-dotimes}, @code{cl-dolist}, @code{cl-do-symbols}.
 * Loop Facility::          The Common Lisp @code{loop} macro.
 * Multiple Values::        @code{cl-values}, @code{cl-multiple-value-bind}, etc.
-* Macro-Writing Macros::   @code{cl-with-gensyms}, @code{cl-once-only}.
+* Macro-Writing Macros::   @code{cl-with-gensyms}, @code{cl-once-only}, @code{cl-once-only*}.
 @end menu
 
 @node Assignment
@@ -2683,6 +2683,73 @@ Macro-Writing Macros
 @end example
 @end defmac
 
+@defmac cl-once-only* (variable forms) body
+This macro is a version of @code{cl-once-only} which takes an
+arbitrarily long list of forms.  This macro is primarily meant to be
+used where the number of forms is unknown and thus @code{cl-once-only}
+cannot work, such as those obtained by a @code{&body} argument.
+
+Each element of @var{variable} may be used to refer to the result of
+evaluating the corresponding form in @var{forms} within @var{body}.
+@code{cl-once-only*} binds @var{variable} to a list of fresh uninterned
+symbols.  @code{cl-once-only*} furthermore wraps the final expansion
+such that each form is evaluated in order and its result is bound to the
+corresponding symbol.
+
+Like @code{cl-once-only}, the first argument can be a symbol @var{variable}, which
+is equivalent to writing @code{(variable variable)}.
+
+Consider the following macro:
+
+@example
+(defmacro my-list (vals &rest forms)
+  (let ((val-results (mapcar (lambda (_) (gensym)) vals)))
+    `(let* ,(cl-mapcar #'list val-results vals)
+       (list ,(cl-first val-results)
+             ,(cl-second val-results)
+             ,@@val-results
+             (progn ,@@forms)))))
+@end example
+
+In a call like @code{(my-list ((pop foo) (cl-incf bar) ...) ...)} the
+@code{pop} and @code{cl-incf} will be evaluated exactly once, ensuring
+their side effects are not applied twice.  This code is however very
+complex, in the same way code not using @code{cl-once-only} is.
+
+Using @code{cl-once-only} is not possible directly due to it expecting
+individual forms which can be evaluated.  This can be worked around by
+assigning to a variable @code{`(list ,@@vars)} which @emph{can} be
+evaluated:
+
+@example
+(defmacro my-list (vals &rest forms)
+  (cl-once-only ((vals `(list ,@@vals)))
+    `(list (cl-first ,vals)
+           (cl-second ,vals)
+           ,vals                        ; Does not splice
+           (progn ,@@forms))))
+@end example
+
+There are two problems which both result from the fact that @code{vals}
+is not a list inside the body of @code{cl-once-only}: 1. @code{vals}
+cannot be spliced in the way it can in the previous example and
+2. accessing individual elements of @code{vals} can only be done by
+accessing the resulting list @emph{during evaluation}.  Compare this to
+the example using @code{cl-once-only*}:
+
+@example
+(defmacro my-list (vals &rest forms)
+  (cl-once-only* vals
+    `(list ,(cl-first vals)
+           ,(cl-second vals)
+           ,@@vals
+           (progn ,@@forms))))
+@end example
+
+which preserves the fact the @var{vals} is a list and removes
+boiler-plate code for generating and assigning temporary variables.
+@end defmac
+
 @node Macros
 @chapter Macros
 
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 2e501005bf7..adb9cb29104 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2544,6 +2544,54 @@ cl-once-only
                           collect `(,(car name) ,gensym))
              ,@body)))))
 
+(defmacro cl-once-only* (listvar &rest body)
+  "Generate code to evaluate the list of FORMS just once in BODY.
+
+This is a macro to be used while defining other macros.  FORMS is
+evaluated once during macroexpansion to obtain the list of forms.  In
+the fully expanded code those forms will be evaluated once before BODY
+and their results will be bound to fresh uninterned variables, one for
+each form.
+
+Within the macro VARIABLE is a list of these symbols in order, such that
+each form in FORMS can be accessed by using the corresponding element in
+VARIABLE.
+
+The common case of `(cl-once-only* (VARIABLE VARIABLE) ...)' can be
+written shortly as `(cl-once-only* VARIABLE ...)'.
+
+For example, the following macro:
+
+  (defmacro my-list (head &rest args)
+    (cl-once-only* args
+      \\=`(list (,head ,@args) ,@args)))
+
+when called like
+
+  (let ((x \\='(1 5 4)))
+    (my-list + (pop x) (1+ (pop x)) (1- (pop x))))
+
+will expand into
+
+  (let ((x \\='(1 5 4)))
+    (let* ((arg1 (pop x)) (arg2 (1+ (pop x))) (arg3 (1- (pop x))))
+      (list (+ arg1 arg2 arg3) arg1 arg2 arg3)))
+
+and the arguments will be evaluated only once and in order.
+
+\(fn (VARIABLE FORMS) &body BODY)"
+  (declare (debug ([&or symbolp (symbolp form)] body)) (indent 1))
+  (let* ((variable (if (symbolp listvar) listvar (nth 0 listvar)))
+         (forms    (if (symbolp listvar) listvar (nth 1 listvar)))
+         (results* (gensym (symbol-name variable))))
+    (cl-once-only (forms)
+      `(let ((,results*
+              (cl-loop for i from 1 to (length ,forms) collect
+                       (make-symbol (format "%s$%d" ',(symbol-name variable) i)))))
+         `(let* ,(cl-mapcar #'list ,results* ,forms)
+            ,(let ((,variable ,results*))
+               ,@body))))))
+
 ;;; Multiple values.
 
 ;;;###autoload