From 18f72562f888d0abe56601544b23358429b7afcd Mon Sep 17 00:00:00 2001
From: Thuna <thuna.cing@gmail.com>
Date: Sun, 4 Aug 2024 00:30:44 +0200
Subject: [PATCH] Add a version of cl-once-only which works on a list of forms

---
 doc/misc/cl.texi           | 49 +++++++++++++++++++++++++++++++++++++-
 lisp/emacs-lisp/cl-macs.el | 48 +++++++++++++++++++++++++++++++++++++
 2 files changed, 96 insertions(+), 1 deletion(-)

diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 113029700ec..57e2f3a6c3b 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,53 @@ 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 a 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 (head &rest args)
+  (cl-once-only ((args `(list ,@@args))
+    `(list (apply #',head ,args)
+           ,args
+           (nth 1 ,args))))
+@end example
+
+This macro is such that it will evaluate @var{args} only once, however
+that @var{args} was a list is lost once we are in @code{cl-once-only}.
+Furthermore, to access any specific element of @var{args} we must obtain
+the element during evaluation via @code{(nth N ,args)}.
+
+Consider the alternative using @code{cl-once-only*}:
+
+@example
+(defmacro my-list (head &rest args)
+  (cl-once-only* args
+    `(list (,head ,@@args)
+           (list ,@@args)
+           ,(nth 1 args))))
+@end example
+
+which preserves the fact that @var{args} is a list and allows immediate
+access to individual arguments by simply choosing the corresponding
+element in @var{args}.
+@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
-- 
2.44.2