From e6ca5834a6eab91023e9f968b65683d0a74db1e7 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= <mattiase@acm.org>
Date: Thu, 20 Apr 2023 15:07:06 +0200
Subject: [PATCH] Improved nconc and append compiler optimisations

Add the transforms:

  (nconc) -> nil
  (nconc X) -> X

and for arguments to `nconc`:

  nil -> <elided>
  (list X...) (list Y...) -> (list X... Y...)
  (list X) Y -> (cons X Y)

* lisp/emacs-lisp/byte-opt.el (byte-optimize-nconc): New.
(byte-optimize-append): Fix minor flaws and generalise.
---
 lisp/emacs-lisp/byte-opt.el | 47 +++++++++++++++++++++++++++++--------
 1 file changed, 37 insertions(+), 10 deletions(-)

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 2bdd3375728..da997212eef 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1520,6 +1520,35 @@ See Info node `(elisp) Integer Basics'."
   ;; (list) -> nil
   (and (cdr form) form))
 
+(put 'nconc 'byte-optimizer #'byte-optimize-nconc)
+(defun byte-optimize-nconc (form)
+  (pcase (cdr form)
+    ('nil nil)                          ; (nconc) -> nil
+    (`(,x) x)                           ; (nconc X) -> X
+    (_ (named-let loop ((args (cdr form)) (newargs nil))
+         (if args
+             (let ((arg (car args))
+                   (prev (car newargs)))
+               (cond
+                ;; Elide null args.
+                ((null arg) (loop (cdr args) newargs))
+                ;; Merge consecutive `list' args.
+                ((and (eq (car-safe arg) 'list)
+                      (eq (car-safe prev) 'list))
+                 (loop (cons (cons (car prev) (append (cdr prev) (cdr arg)))
+                             (cdr args))
+                       (cdr newargs)))
+                ;; (nconc ... (list A) B ...) -> (nconc ... (cons A B) ...)
+                ((and (eq (car-safe prev) 'list) (cdr prev) (null (cddr prev)))
+                 (loop (cdr args)
+                       (cons (list 'cons (cadr prev) arg)
+                             (cdr newargs))))
+                (t (loop (cdr args) (cons arg newargs)))))
+           (let ((new-form (cons (car form) (nreverse newargs))))
+             (if (equal new-form form)
+                 form
+               new-form)))))))
+
 (put 'append 'byte-optimizer #'byte-optimize-append)
 (defun byte-optimize-append (form)
   ;; There is (probably) too much code relying on `append' to return a
@@ -1572,11 +1601,9 @@ See Info node `(elisp) Integer Basics'."
             ;; (append X) -> X
             ((null newargs) arg)
 
-            ;; (append (list Xs...) nil) -> (list Xs...)
-            ((and (null arg)
-                  newargs (null (cdr newargs))
-                  (consp prev) (eq (car prev) 'list))
-             prev)
+            ;; (append ... (list Xs...) nil) -> (append ... (list Xs...))
+            ((and (null arg) (eq (car-safe prev) 'list))
+             (cons (car form) (nreverse newargs)))
 
             ;; (append '(X) Y)     -> (cons 'X Y)
             ;; (append (list X) Y) -> (cons X Y)
@@ -1587,13 +1614,13 @@ See Info node `(elisp) Integer Basics'."
                               (= (length (cadr prev)) 1)))
                         ((eq (car prev) 'list)
                          (= (length (cdr prev)) 1))))
-             (list 'cons (if (eq (car prev) 'quote)
-                             (macroexp-quote (caadr prev))
-                           (cadr prev))
-                   arg))
+             `(cons ,(if (eq (car prev) 'quote)
+                         (macroexp-quote (caadr prev))
+                       (cadr prev))
+                    ,arg))
 
             (t
-             (let ((new-form (cons 'append (nreverse (cons arg newargs)))))
+             (let ((new-form (cons (car form) (nreverse (cons arg newargs)))))
                (if (equal new-form form)
                    form
                  new-form))))))))
-- 
2.39.2