bug#14769: [PATCH] optimize `concat's literals

["Mattias Engdegård" <mattiase@acm.org>]

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

Since this bug was mentioned in  https://debbugs.gnu.org/36237, here is a slightly reworked version that does not special-case `concat' in the general code.


[-- Attachment #2: 0001-Merge-consecutive-constant-concat-args-bug-14769.patch --]
[-- Type: application/octet-stream, Size: 2312 bytes --]

From 4a65b351c5f72a7d53904c57137c69bd6dc4d568 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= <mattiase@acm.org>
Date: Sun, 16 Jun 2019 13:13:47 +0200
Subject: [PATCH] Merge consecutive constant `concat' args (bug#14769)

Suggested by Shigeru Fukaya <shigeru.fukaya@gmail.com>

* lisp/emacs-lisp/byte-opt.el (byte-optimize-concat): New.
(concat): Add byte-optimizer.
---
 lisp/emacs-lisp/byte-opt.el | 25 +++++++++++++++++++++++++
 1 file changed, 25 insertions(+)

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 44cca6136c..1ebafec3f2 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -850,6 +850,29 @@ byte-optimize-memq
                           ',list)))))
     (byte-optimize-predicate form)))
 
+(defun byte-optimize-concat (form)
+  "Merge adjacent constant arguments to `concat'."
+  (let ((args nil)
+        (accum nil))
+    (dolist (arg (cdr form))
+      (unless (and (macroexp-const-p arg)
+                   (let ((val (eval arg)))
+                     (and (or (stringp val)
+                              (and (or (listp val) (vectorp val))
+                                   (not (memq nil (mapcar #'characterp val)))))
+                          ;; Constant arg: concat with previous.
+                          (setq accum (concat accum val)))))
+        ;; Non-constant arg.
+        (when (and accum (not (zerop (length accum))))
+          (push accum args))
+        (push arg args)
+        (setq accum nil)))
+    (when (and accum (not (zerop (length accum))))
+      (push accum args))
+    (if (= (length args) (length (cdr form)))
+        form          ; No improvement.
+      (cons 'concat (nreverse args)))))
+
 (put 'identity 'byte-optimizer 'byte-optimize-identity)
 (put 'memq 'byte-optimizer 'byte-optimize-memq)
 
@@ -892,6 +915,8 @@ byte-optimize-memq
 (put 'car-safe 'byte-optimizer 'byte-optimize-predicate)
 (put 'cdr-safe 'byte-optimizer 'byte-optimize-predicate)
 
+(put 'concat 'byte-optimizer 'byte-optimize-concat)
+
 ;; I'm not convinced that this is necessary.  Doesn't the optimizer loop
 ;; take care of this? - Jamie
 ;; I think this may some times be necessary to reduce ie (quote 5) to 5,
-- 
2.20.1 (Apple Git-117)