unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* [PATCH] Adding with-gensyms and once-only to subr-x
@ 2022-04-11 16:26 Sean Whitton
  2022-04-11 16:48 ` Stefan Monnier
  0 siblings, 1 reply; 13+ messages in thread
From: Sean Whitton @ 2022-04-11 16:26 UTC (permalink / raw)
  To: emacs-devel

[-- Attachment #1: Type: text/plain, Size: 276 bytes --]

Hello,

Lately I have been finding myself wanting with-gensyms and once-only,
two classic macro-writing macros, available in core Elisp.  (There is
already org-with-gensyms, but it's not in the least bit Org-specific.)

Here is my implementation for review.

-- 
Sean Whitton

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-lisp-emacs-lisp-subr-x.el-with-gensyms-once-only-New.patch --]
[-- Type: text/x-diff, Size: 2430 bytes --]

From 89e86db1ccb97ce3f91d5b4beb5d7b461311d196 Mon Sep 17 00:00:00 2001
From: Sean Whitton <spwhitton@spwhitton.name>
Date: Mon, 11 Apr 2022 09:20:35 -0700
Subject: [PATCH] * lisp/emacs-lisp/subr-x.el (with-gensyms, once-only): New
 macros.

---
 lisp/emacs-lisp/subr-x.el | 43 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 43 insertions(+)

diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index abf85ab6c6..c74bf7f5f0 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -526,6 +526,49 @@ read-process-name
         (error "No process selected"))
       process)))
 
+(defmacro with-gensyms (names &rest body)
+  "Bind each of NAMES to an uninterned symbol and evaluate BODY."
+  (declare (debug (sexp body)) (indent 1))
+  `(let ,(cl-loop for name in names collect
+                  `(,name (gensym (symbol-name ',name))))
+     ,@body))
+
+(defmacro once-only (names &rest body)
+  "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)
+      (once-only (x)
+        `(cons ,x ,x)))
+
+Consider the call (my-cons (pop y)).  This will expand to
+something like this:
+
+    (let ((g1 (pop y)))
+      (cons g1 g1))
+
+This ensures that the pop is performed only once, as wanted."
+  (declare (debug (sexp body)) (indent 1))
+  (setq names (mapcar #'ensure-list names))
+  (let ((our-gensyms (cl-loop for name in names collect (gensym))))
+    ;; During macroexpansion, obtain a gensym for each NAME.
+    `(let ,(cl-loop for sym in our-gensyms collect `(,sym (gensym)))
+       ;; Evaluate each FORM and bind to the corresponding gensym.
+       `(let (,,@(cl-loop for name in names and gensym in our-gensyms
+                          for to-eval = (or (cadr name) (car name))
+                          collect ``(,,gensym ,,to-eval)))
+          ;; During macroexpansion, bind each NAME to its gensym.
+          ,(let ,(cl-loop for name in names and gensym in our-gensyms
+                          collect `(,(car name) ,gensym))
+             ,@body)))))
+
 (provide 'subr-x)
 
 ;;; subr-x.el ends here
-- 
2.30.2


^ permalink raw reply related	[flat|nested] 13+ messages in thread

end of thread, other threads:[~2022-04-12  6:02 UTC | newest]

Thread overview: 13+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-04-11 16:26 [PATCH] Adding with-gensyms and once-only to subr-x Sean Whitton
2022-04-11 16:48 ` Stefan Monnier
2022-04-11 17:01   ` Sean Whitton
2022-04-11 17:26     ` Stefan Monnier
2022-04-11 18:41       ` Sean Whitton
2022-04-11 19:11         ` Stefan Monnier
2022-04-11 20:25           ` Sean Whitton
2022-04-11 21:11             ` Stefan Monnier
2022-04-11 23:05               ` Sean Whitton
2022-04-11 23:15                 ` Sean Whitton
2022-04-12  0:06           ` Sean Whitton
2022-04-12  3:08             ` Stefan Monnier
2022-04-12  6:02               ` Sean Whitton

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).