summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp/byte-opt.el
diff options
context:
space:
mode:
authorMattias EngdegÄrd <mattiase@acm.org>2023-04-20 15:07:06 +0200
committerMattias EngdegÄrd <mattiase@acm.org>2023-04-22 09:47:23 +0200
commite6ca5834a6eab91023e9f968b65683d0a74db1e7 (patch)
tree146b8d8e64cd321fd41871354ee16758f1bbfce8 /lisp/emacs-lisp/byte-opt.el
parent4f3dae2b0d5fc43e5e2effa6d36544b6de2a43d8 (diff)
downloademacs-e6ca5834a6eab91023e9f968b65683d0a74db1e7.tar.gz
emacs-e6ca5834a6eab91023e9f968b65683d0a74db1e7.tar.bz2
emacs-e6ca5834a6eab91023e9f968b65683d0a74db1e7.zip
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.
Diffstat (limited to 'lisp/emacs-lisp/byte-opt.el')
-rw-r--r--lisp/emacs-lisp/byte-opt.el47
1 files 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))))))))