[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master fab1e22 1/3: Optimise `member` and `assoc` (etc) with constant em
From: |
Mattias Engdegård |
Subject: |
master fab1e22 1/3: Optimise `member` and `assoc` (etc) with constant empty list |
Date: |
Mon, 6 Sep 2021 10:48:37 -0400 (EDT) |
branch: master
commit fab1e220dbe38ab7a2f46b673dfc03964e496798
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>
Optimise `member` and `assoc` (etc) with constant empty list
* lisp/emacs-lisp/byte-opt.el
(byte-optimize-assq): New.
(byte-optimize-member, byte-optimize-assoc, byte-optimize-memq):
When the list argument is constant nil, the result is always nil.
* test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases):
Add test cases.
---
lisp/emacs-lisp/byte-opt.el | 66 +++++++++++++++++++++-------------
test/lisp/emacs-lisp/bytecomp-tests.el | 15 ++++++++
2 files changed, 56 insertions(+), 25 deletions(-)
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 6475f69..0c30d83 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -967,24 +967,25 @@ See Info node `(elisp) Integer Basics'."
(_ (byte-optimize-binary-predicate form))))
(defun byte-optimize-member (form)
- ;; Replace `member' or `memql' with `memq' if the first arg is a symbol,
- ;; or the second arg is a list of symbols. Same with fixnums.
- (if (= (length (cdr form)) 2)
- (if (or (byte-optimize--constant-symbol-p (nth 1 form))
- (byte-optimize--fixnump (nth 1 form))
- (let ((arg2 (nth 2 form)))
- (and (macroexp-const-p arg2)
- (let ((listval (eval arg2)))
- (and (listp listval)
- (not (memq nil (mapcar
- (lambda (o)
- (or (symbolp o)
- (byte-optimize--fixnump o)))
- listval))))))))
- (cons 'memq (cdr form))
- form)
- ;; Arity errors reported elsewhere.
- form))
+ (cond
+ ((/= (length (cdr form)) 2) form) ; arity error
+ ((null (nth 2 form)) ; empty list
+ `(progn ,(nth 1 form) nil))
+ ;; Replace `member' or `memql' with `memq' if the first arg is a symbol
+ ;; or fixnum, or the second arg is a list of symbols or fixnums.
+ ((or (byte-optimize--constant-symbol-p (nth 1 form))
+ (byte-optimize--fixnump (nth 1 form))
+ (let ((arg2 (nth 2 form)))
+ (and (macroexp-const-p arg2)
+ (let ((listval (eval arg2)))
+ (and (listp listval)
+ (not (memq nil (mapcar
+ (lambda (o)
+ (or (symbolp o)
+ (byte-optimize--fixnump o)))
+ listval))))))))
+ (cons 'memq (cdr form)))
+ (t form)))
(defun byte-optimize-assoc (form)
;; Replace 2-argument `assoc' with `assq', `rassoc' with `rassq',
@@ -992,22 +993,35 @@ See Info node `(elisp) Integer Basics'."
(cond
((/= (length form) 3)
form)
+ ((null (nth 2 form)) ; empty list
+ `(progn ,(nth 1 form) nil))
((or (byte-optimize--constant-symbol-p (nth 1 form))
(byte-optimize--fixnump (nth 1 form)))
(cons (if (eq (car form) 'assoc) 'assq 'rassq)
(cdr form)))
(t (byte-optimize-constant-args form))))
+(defun byte-optimize-assq (form)
+ (cond
+ ((/= (length form) 3)
+ form)
+ ((null (nth 2 form)) ; empty list
+ `(progn ,(nth 1 form) nil))
+ (t (byte-optimize-constant-args form))))
+
(defun byte-optimize-memq (form)
- ;; (memq foo '(bar)) => (and (eq foo 'bar) '(bar))
(if (= (length (cdr form)) 2)
(let ((list (nth 2 form)))
- (if (and (eq (car-safe list) 'quote)
- (listp (setq list (cadr list)))
- (= (length list) 1))
- `(and (eq ,(nth 1 form) ',(nth 0 list))
- ',list)
- form))
+ (cond
+ ((null list) ; empty list
+ `(progn ,(nth 1 form) nil))
+ ;; (memq foo '(bar)) => (and (eq foo 'bar) '(bar))
+ ((and (eq (car-safe list) 'quote)
+ (listp (setq list (cadr list)))
+ (= (length list) 1))
+ `(and (eq ,(nth 1 form) ',(nth 0 list))
+ ',list))
+ (t form)))
;; Arity errors reported elsewhere.
form))
@@ -1044,6 +1058,8 @@ See Info node `(elisp) Integer Basics'."
(put 'member 'byte-optimizer #'byte-optimize-member)
(put 'assoc 'byte-optimizer #'byte-optimize-assoc)
(put 'rassoc 'byte-optimizer #'byte-optimize-assoc)
+(put 'assq 'byte-optimizer #'byte-optimize-assq)
+(put 'rassq 'byte-optimizer #'byte-optimize-assq)
(put '+ 'byte-optimizer #'byte-optimize-plus)
(put '* 'byte-optimizer #'byte-optimize-multiply)
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 80003c2..ac96494 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -536,6 +536,21 @@
(let ((_a 1)
(_b 2))
'z)
+
+ ;; Check empty-list optimisations.
+ (mapcar (lambda (x) (member x nil)) '("a" 2 nil))
+ (mapcar (lambda (x) (memql x nil)) '(a 2 nil))
+ (mapcar (lambda (x) (memq x nil)) '(a nil))
+ (let ((n 0))
+ (list (mapcar (lambda (x) (member (setq n (1+ n)) nil)) '(a "nil"))
+ n))
+ (mapcar (lambda (x) (assoc x nil)) '("a" nil))
+ (mapcar (lambda (x) (assq x nil)) '(a nil))
+ (mapcar (lambda (x) (rassoc x nil)) '("a" nil))
+ (mapcar (lambda (x) (rassq x nil)) '(a nil))
+ (let ((n 0))
+ (list (mapcar (lambda (x) (assoc (setq n (1+ n)) nil)) '(a "nil"))
+ n))
)
"List of expressions for cross-testing interpreted and compiled code.")