compat-29: Add cl-with-gensyms and cl-once-only

1 files changed, 47 insertions, 0 deletions

diff --git a/compat-29.el b/compat-29.el
index bc508fb..15a8415 100644
--- a/compat-29.el
+++ b/compat-29.el
@@ -1340,6 +1340,53 @@ Also see `buttonize'."
           (setq sentences (1- sentences)))
         sentences))))
 
+;;;; Defined in cl-macs.el
+
+(compat-defmacro cl-with-gensyms (names &rest body) ;; <compat-tests:cl-with-gensyms>
+  "Bind each of NAMES to an uninterned symbol and evaluate BODY."
+  ;; No :feature since macro is autoloaded
+  (declare (debug (sexp body)) (indent 1))
+  `(let ,(cl-loop for name in names collect
+                  `(,name (gensym (symbol-name ',name))))
+     ,@body))
+
+(compat-defmacro cl-once-only (names &rest body) ;; <compat-tests:cl-once-only>
+  "Generate code to evaluate each of NAMES just once in BODY.
+
+This macro helps with writing other macros.  Each of names is
+either (NAME FORM) or NAME, which latter means (NAME NAME).
+During macroexpansion, each NAME is bound to an uninterned
+symbol.  The expansion evaluates each FORM and binds it to the
+corresponding uninterned symbol.
+
+For example, consider this macro:
+
+    (defmacro my-cons (x)
+      (cl-once-only (x)
+        \\=`(cons ,x ,x)))
+
+The call (my-cons (pop y)) will expand to something like this:
+
+    (let ((g1 (pop y)))
+      (cons g1 g1))
+
+The use of `cl-once-only' ensures that the pop is performed only
+once, as intended.
+
+See also `macroexp-let2'."
+  ;; No :feature since macro is autoloaded
+  (declare (debug (sexp body)) (indent 1))
+  (setq names (mapcar #'ensure-list names))
+  (let ((our-gensyms (cl-loop for _ in names collect (gensym))))
+    `(let ,(cl-loop for sym in our-gensyms collect `(,sym (gensym)))
+       `(let ,(list
+               ,@(cl-loop for name in names for gensym in our-gensyms
+                          for to-eval = (or (cadr name) (car name))
+                          collect ``(,,gensym ,,to-eval)))
+          ,(let ,(cl-loop for name in names for gensym in our-gensyms
+                          collect `(,(car name) ,gensym))
+             ,@body)))))
+
 ;;;; Defined in ert-x.el
 
 (compat-defmacro ert-with-temp-file (name &rest body) ;; <compat-tests:ert-with-temp-file>