From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Thu, 7 Apr 2011 13:05:01 +0000 (+0000)
Subject: 1.0.47.14: optimize list DELETE to DELQ in more cases
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=5f9cb3705865f7538cc3943c7cb134989d94a619;p=sbcl.git

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.
---

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"