From 260b6c2c931d74ef64dacb20b7fcae6f888e6d42 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sun, 16 Jun 2019 13:13:47 +0200 Subject: [PATCH] Merge consecutive constant `concat' args (bug#14769) Suggested by Shigeru Fukaya * lisp/emacs-lisp/byte-opt.el (byte-optimize-concat): New. (concat): Add byte-optimizer. --- lisp/emacs-lisp/byte-opt.el | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index b0aa407c8b4..2e096016396 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -850,6 +850,33 @@ ',list))))) (byte-optimize-predicate form))) +(defun byte-optimize-concat (form) + "Merge adjacent constant arguments to `concat'." + (let ((args (cdr form)) + (newargs nil)) + (while args + (let ((strings nil) + val) + (while (and args (macroexp-const-p (car args)) + (progn + (setq val (eval (car args))) + (and (or (stringp val) + (and (or (listp val) (vectorp val)) + (not (memq nil + (mapcar #'characterp val)))))))) + (push val strings) + (setq args (cdr args))) + (when strings + (let ((s (apply #'concat (nreverse strings)))) + (when (not (zerop (length s))) + (push s newargs))))) + (when args + (push (car args) newargs) + (setq args (cdr args)))) + (if (= (length newargs) (length (cdr form))) + form ; No improvement. + (cons 'concat (nreverse newargs))))) + (put 'identity 'byte-optimizer 'byte-optimize-identity) (put 'memq 'byte-optimizer 'byte-optimize-memq) @@ -892,6 +919,8 @@ (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.39.5