mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

Improved nconc and append compiler optimisations

Browse source 
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.
This commit is contained in:
Mattias Engdegård 2023-04-20 15:07:06 +02:00
parent 4f3dae2b0d
commit e6ca5834a6
1 changed files with 37 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

47
lisp/emacs-lisp/byte-opt.el
View file

@ -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))))))))