diff options
| author | Mattias EngdegÄrd | 2023-04-20 15:07:06 +0200 |
|---|---|---|
| committer | Mattias EngdegÄrd | 2023-04-22 09:47:23 +0200 |
| commit | e6ca5834a6eab91023e9f968b65683d0a74db1e7 (patch) | |
| tree | 146b8d8e64cd321fd41871354ee16758f1bbfce8 | |
| parent | 4f3dae2b0d5fc43e5e2effa6d36544b6de2a43d8 (diff) | |
| download | emacs-e6ca5834a6eab91023e9f968b65683d0a74db1e7.tar.gz 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.
| -rw-r--r-- | lisp/emacs-lisp/byte-opt.el | 47 |
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'." | |||
| 1520 | ;; (list) -> nil | 1520 | ;; (list) -> nil |
| 1521 | (and (cdr form) form)) | 1521 | (and (cdr form) form)) |
| 1522 | 1522 | ||
| 1523 | (put 'nconc 'byte-optimizer #'byte-optimize-nconc) | ||
| 1524 | (defun byte-optimize-nconc (form) | ||
| 1525 | (pcase (cdr form) | ||
| 1526 | ('nil nil) ; (nconc) -> nil | ||
| 1527 | (`(,x) x) ; (nconc X) -> X | ||
| 1528 | (_ (named-let loop ((args (cdr form)) (newargs nil)) | ||
| 1529 | (if args | ||
| 1530 | (let ((arg (car args)) | ||
| 1531 | (prev (car newargs))) | ||
| 1532 | (cond | ||
| 1533 | ;; Elide null args. | ||
| 1534 | ((null arg) (loop (cdr args) newargs)) | ||
| 1535 | ;; Merge consecutive `list' args. | ||
| 1536 | ((and (eq (car-safe arg) 'list) | ||
| 1537 | (eq (car-safe prev) 'list)) | ||
| 1538 | (loop (cons (cons (car prev) (append (cdr prev) (cdr arg))) | ||
| 1539 | (cdr args)) | ||
| 1540 | (cdr newargs))) | ||
| 1541 | ;; (nconc ... (list A) B ...) -> (nconc ... (cons A B) ...) | ||
| 1542 | ((and (eq (car-safe prev) 'list) (cdr prev) (null (cddr prev))) | ||
| 1543 | (loop (cdr args) | ||
| 1544 | (cons (list 'cons (cadr prev) arg) | ||
| 1545 | (cdr newargs)))) | ||
| 1546 | (t (loop (cdr args) (cons arg newargs))))) | ||
| 1547 | (let ((new-form (cons (car form) (nreverse newargs)))) | ||
| 1548 | (if (equal new-form form) | ||
| 1549 | form | ||
| 1550 | new-form))))))) | ||
| 1551 | |||
| 1523 | (put 'append 'byte-optimizer #'byte-optimize-append) | 1552 | (put 'append 'byte-optimizer #'byte-optimize-append) |
| 1524 | (defun byte-optimize-append (form) | 1553 | (defun byte-optimize-append (form) |
| 1525 | ;; There is (probably) too much code relying on `append' to return a | 1554 | ;; There is (probably) too much code relying on `append' to return a |
| @@ -1572,11 +1601,9 @@ See Info node `(elisp) Integer Basics'." | |||
| 1572 | ;; (append X) -> X | 1601 | ;; (append X) -> X |
| 1573 | ((null newargs) arg) | 1602 | ((null newargs) arg) |
| 1574 | 1603 | ||
| 1575 | ;; (append (list Xs...) nil) -> (list Xs...) | 1604 | ;; (append ... (list Xs...) nil) -> (append ... (list Xs...)) |
| 1576 | ((and (null arg) | 1605 | ((and (null arg) (eq (car-safe prev) 'list)) |
| 1577 | newargs (null (cdr newargs)) | 1606 | (cons (car form) (nreverse newargs))) |
| 1578 | (consp prev) (eq (car prev) 'list)) | ||
| 1579 | prev) | ||
| 1580 | 1607 | ||
| 1581 | ;; (append '(X) Y) -> (cons 'X Y) | 1608 | ;; (append '(X) Y) -> (cons 'X Y) |
| 1582 | ;; (append (list X) Y) -> (cons X Y) | 1609 | ;; (append (list X) Y) -> (cons X Y) |
| @@ -1587,13 +1614,13 @@ See Info node `(elisp) Integer Basics'." | |||
| 1587 | (= (length (cadr prev)) 1))) | 1614 | (= (length (cadr prev)) 1))) |
| 1588 | ((eq (car prev) 'list) | 1615 | ((eq (car prev) 'list) |
| 1589 | (= (length (cdr prev)) 1)))) | 1616 | (= (length (cdr prev)) 1)))) |
| 1590 | (list 'cons (if (eq (car prev) 'quote) | 1617 | `(cons ,(if (eq (car prev) 'quote) |
| 1591 | (macroexp-quote (caadr prev)) | 1618 | (macroexp-quote (caadr prev)) |
| 1592 | (cadr prev)) | 1619 | (cadr prev)) |
| 1593 | arg)) | 1620 | ,arg)) |
| 1594 | 1621 | ||
| 1595 | (t | 1622 | (t |
| 1596 | (let ((new-form (cons 'append (nreverse (cons arg newargs))))) | 1623 | (let ((new-form (cons (car form) (nreverse (cons arg newargs))))) |
| 1597 | (if (equal new-form form) | 1624 | (if (equal new-form form) |
| 1598 | form | 1625 | form |
| 1599 | new-form)))))))) | 1626 | new-form)))))))) |