Quality of life improvements to macroexp.el

[Thuna <thuna.cing@gmail.com>]

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

I was just looking into using macroexp.el and found some features that I
felt were lacking.  These were: 1. accepting multiple forms in
`macroexp-if' and `macroexp-let*', 2. flattening of `progn's in
`macroexp-progn' and `macroexp-unprogn', 3. getting rid of branches in
`macroexp-if' in case the TEST is constant (and consequently a way to
tell whether a constant form is nil or non-nil).  I've went through the
rest of macroexp.el and haven't found anything else that stood out,
though I might change my mind as I keep using it.

I've attached a patch for possible implementations of these, though this
is mostly so that I put this out there as a suggestion; considering how
many things depend on macroexp.el there might be good reasons why these
features are not worth the effort and possible bugs that come about due
to these changes.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Patch for macroexp.el --]
[-- Type: text/x-patch, Size: 6032 bytes --]

From 46f8f769aac7b59d25ecd413d9a7d6f75a78b5d2 Mon Sep 17 00:00:00 2001
From: Thuna <thuna.cing@gmail.com>
Date: Tue, 16 Jul 2024 03:44:28 +0200
Subject: [PATCH] Quality of life improvements in macroexp.el

* macroexp.el (macroexp-progn macroexp-unprogn): Flatten any nested
`progn's.
(macroexp-if): Accept multiple ELSE arguments.  If TEST is always nil or
non-nil, return only TEST or ELSE (as a progn) respectively.
(macroexp-null): Define form to check whether a form will always return
nil.  With this and `macroexp-const-p' we also have a way to check if it
will always return non-nil(?).
---
 lisp/emacs-lisp/macroexp.el | 94 ++++++++++++++++++++++---------------
 1 file changed, 57 insertions(+), 37 deletions(-)

diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index f4df40249de..c8e0850226e 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -536,50 +536,61 @@ macroexp-parse-body
 
 (defun macroexp-progn (exps)
   "Return EXPS (a list of expressions) with `progn' prepended.
-If EXPS is a list with a single expression, `progn' is not
-prepended, but that expression is returned instead."
-  (if (cdr exps) `(progn ,@exps) (car exps)))
+If EXPS is a list with a single expression, `progn' is not prepended,
+but that expression is returned instead.  If EXPS is the empty list,
+return nil."
+  (let ((exps (remq nil (mapcan #'macroexp-unprogn exps))))
+    (cond ((null exps) nil)
+          ((null (cdr exps)) (car exps))
+          (t `(progn ,@exps)))))
 
 (defun macroexp-unprogn (exp)
   "Turn EXP into a list of expressions to execute in sequence.
 Never returns an empty list."
-  (if (eq (car-safe exp) 'progn) (or (cdr exp) '(nil)) (list exp)))
-
-(defun macroexp-let* (bindings exp)
-  "Return an expression equivalent to \\=`(let* ,BINDINGS ,EXP)."
-  (cond
-   ((null bindings) exp)
-   ((eq 'let* (car-safe exp)) `(let* (,@bindings ,@(cadr exp)) ,@(cddr exp)))
-   (t `(let* ,bindings ,exp))))
+  (if (eq (car-safe exp) 'progn)
+      (or (remq nil (mapcan #'macroexp-unprogn (cdr exp)))
+          (list nil))
+    (list exp)))
+
+(defun macroexp-let* (bindings &rest exps)
+  "Return an expression equivalent to \\=`(let* ,BINDINGS ,@EXPS)."
+  (let ((exp (macroexp-progn exps)))
+    (cond
+     ((null bindings) exp)
+     ((eq 'let* (car-safe exp)) `(let* (,@bindings ,@(cadr exp)) ,@(cddr exp)))
+     (t `(let* ,bindings ,@exps)))))
 
-(defun macroexp-if (test then else)
+(defun macroexp-if (test then &rest else)
   "Return an expression equivalent to \\=`(if ,TEST ,THEN ,ELSE)."
-  (cond
-   ((eq (car-safe else) 'if)
+  (let ((else (macroexp-progn else)))
     (cond
-     ;; Drop this optimization: It's unsafe (it assumes that `test' is
-     ;; pure, or at least idempotent), and it's not used even a single
-     ;; time while compiling Emacs's sources.
-     ;;((equal test (nth 1 else))
-     ;; ;; Doing a test a second time: get rid of the redundancy.
-     ;; (message "macroexp-if: sharing 'test' %S" test)
-     ;; `(if ,test ,then ,@(nthcdr 3 else)))
-     ((equal then (nth 2 else))
-      ;; (message "macroexp-if: sharing 'then' %S" then)
-      `(if (or ,test ,(nth 1 else)) ,then ,@(nthcdr 3 else)))
-     ((equal (macroexp-unprogn then) (nthcdr 3 else))
-      ;; (message "macroexp-if: sharing 'then' with not %S" then)
-      `(if (or ,test (not ,(nth 1 else)))
-           ,then ,@(macroexp-unprogn (nth 2 else))))
-     (t
-      `(cond (,test ,@(macroexp-unprogn then))
-             (,(nth 1 else) ,@(macroexp-unprogn (nth 2 else)))
-             ,@(let ((def (nthcdr 3 else))) (if def `((t ,@def))))))))
-   ((eq (car-safe else) 'cond)
-    `(cond (,test ,@(macroexp-unprogn then)) ,@(cdr else)))
-   ;; Invert the test if that lets us reduce the depth of the tree.
-   ((memq (car-safe then) '(if cond)) (macroexp-if `(not ,test) else then))
-   (t `(if ,test ,then ,@(if else (macroexp-unprogn else))))))
+     ((macroexp-null test) else)
+     ((macroexp-const-p test) then)
+     ((eq (car-safe else) 'if)
+      (cond
+       ;; Drop this optimization: It's unsafe (it assumes that `test' is
+       ;; pure, or at least idempotent), and it's not used even a single
+       ;; time while compiling Emacs's sources.
+       ;;((equal test (nth 1 else))
+       ;; ;; Doing a test a second time: get rid of the redundancy.
+       ;; (message "macroexp-if: sharing 'test' %S" test)
+       ;; `(if ,test ,then ,@(nthcdr 3 else)))
+       ((equal then (nth 2 else))
+        ;; (message "macroexp-if: sharing 'then' %S" then)
+        `(if (or ,test ,(nth 1 else)) ,then ,@(nthcdr 3 else)))
+       ((equal (macroexp-unprogn then) (nthcdr 3 else))
+        ;; (message "macroexp-if: sharing 'then' with not %S" then)
+        `(if (or ,test (not ,(nth 1 else)))
+             ,then ,@(macroexp-unprogn (nth 2 else))))
+       (t
+        `(cond (,test ,@(macroexp-unprogn then))
+               (,(nth 1 else) ,@(macroexp-unprogn (nth 2 else)))
+               ,@(let ((def (nthcdr 3 else))) (if def `((t ,@def))))))))
+     ((eq (car-safe else) 'cond)
+      `(cond (,test ,@(macroexp-unprogn then)) ,@(cdr else)))
+     ;; Invert the test if that lets us reduce the depth of the tree.
+     ((memq (car-safe then) '(if cond)) (macroexp-if `(not ,test) else then))
+     (t `(if ,test ,then ,@(if else (macroexp-unprogn else)))))))
 
 (defmacro macroexp-let2 (test sym exp &rest body)
   "Evaluate BODY with SYM bound to an expression for EXP's value.
@@ -677,6 +688,15 @@ macroexp--const-symbol-p
 		       (progn (set symbol (symbol-value symbol)) nil)
 		     (setting-constant t)))))))
 
+(defun macroexp-null (exp)
+  "Return non-nil if EXP will always evaluate to nil."
+  (or (eq exp nil)
+      (and (consp exp)
+           (memq (car exp) '(function quote \`))
+           (cdr exp)
+           (eq (cadr exp) nil)
+           (null (cadr exp)))))
+
 (defun macroexp-const-p (exp)
   "Return non-nil if EXP will always evaluate to the same value."
   (cond ((consp exp) (or (eq (car exp) 'quote)
-- 
2.44.2