From 5f9cb3705865f7538cc3943c7cb134989d94a619 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Thu, 7 Apr 2011 13:05:01 +0000 Subject: [PATCH] 1.0.47.14: optimize list DELETE to DELQ in more cases Optimize in the presence of explicit EQL test if the item is known to be such that EQ and EQL work the same. Optimize for implicit EQL for fixnums as well -- not just non-numbers as previously. --- src/compiler/seqtran.lisp | 20 +++++--------------- tests/compiler.pure.lisp | 13 +++++++++++++ version.lisp-expr | 2 +- 3 files changed, 19 insertions(+), 16 deletions(-) diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index 5e4de7f..7775528 100644 --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -482,21 +482,11 @@ ;;; almost as fast as MEMQ. (deftransform delete ((item list &key test) (t list &rest t) *) "convert to EQ test" - ;; FIXME: The scope of this transformation could be - ;; widened somewhat, letting it work whenever the test is - ;; 'EQL and we know from the type of ITEM that it #'EQ - ;; works like #'EQL on it. (E.g. types FIXNUM, CHARACTER, - ;; and SYMBOL.) - ;; If TEST is EQ, apply transform, else - ;; if test is not EQL, then give up on transform, else - ;; if ITEM is not a NUMBER or is a FIXNUM, apply - ;; transform, else give up on transform. - (cond (test - (unless (lvar-fun-is test '(eq)) - (give-up-ir1-transform))) - ((types-equal-or-intersect (lvar-type item) - (specifier-type 'number)) - (give-up-ir1-transform "Item might be a number."))) + (let ((type (lvar-type item))) + (unless (or (and test (lvar-fun-is test '(eq))) + (and (eq-comparable-type-p type) + (or (not test) (lvar-fun-is test '(eql))))) + (give-up-ir1-transform))) `(delq item list)) (deftransform delete-if ((pred list) (t list)) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index c526464..bd70465 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -3813,3 +3813,16 @@ (member x x :test #.#'eq)))) (assert (member #'sb-kernel:%member-test (ctu:find-named-callees fun))))) + +(with-test (:name :delete-to-delq-opt) + (dolist (fun (list (lambda (x y) + (declare (list y)) + (delete x y :test #'eq)) + (lambda (x y) + (declare (fixnum x) (list y)) + (delete x y)) + (lambda (x y) + (declare (symbol x) (list y)) + (delete x y :test #'eql)))) + (assert (equal (list #'sb-int:delq) + (ctu:find-named-callees fun))))) diff --git a/version.lisp-expr b/version.lisp-expr index 05ddb06..f174645 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -20,4 +20,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.47.13" +"1.0.47.14" -- 1.7.10.4