From 6242b9f8336fee3c0b0e473efb414e39ed3b92c7 Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Thu, 5 Sep 2013 18:35:12 +0400
Subject: [PATCH] Optimize some comparison functions for EQ cases.

Add (or (eq x y) ...) to bit-vector-=, two-arg-char-equal, pathname=.
---
 package-data-list.lisp-expr   |    1 +
 src/code/pred.lisp            |   22 ++++++++++++----------
 src/code/target-char.lisp     |    3 ++-
 src/code/target-pathname.lisp |   27 ++++++++++++++-------------
 src/compiler/fndb.lisp        |    1 +
 5 files changed, 30 insertions(+), 24 deletions(-)

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index d865cc9..c940681 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1066,6 +1066,7 @@ possibly temporariliy, because it might be used internally."
                "NTH-BUT-WITH-SANE-ARG-ORDER"
                "BIT-VECTOR-="
                "PATHNAME="
+               "HASH-TABLE-EQUALP"
                "READ-EVALUATED-FORM"
                "MAKE-UNPRINTABLE-OBJECT"
                "POWER-OF-TWO-CEILING"
diff --git a/src/code/pred.lisp b/src/code/pred.lisp
index f167505..4a6703a 100644
--- a/src/code/pred.lisp
+++ b/src/code/pred.lisp
@@ -243,16 +243,18 @@
 
 (defun bit-vector-= (x y)
   (declare (type bit-vector x y))
-  (if (and (simple-bit-vector-p x)
-           (simple-bit-vector-p y))
-      (bit-vector-= x y) ; DEFTRANSFORM
-      (and (= (length x) (length y))
-           (do ((i 0 (1+ i))
-                (length (length x)))
-               ((= i length) t)
-             (declare (fixnum i))
-             (unless (= (bit x i) (bit y i))
-               (return nil))))))
+  (cond ((eq x y))
+        ((and (simple-bit-vector-p x)
+              (simple-bit-vector-p y))
+         (bit-vector-= x y))            ; DEFTRANSFORM
+        (t
+         (and (= (length x) (length y))
+              (do ((i 0 (1+ i))
+                   (length (length x)))
+                  ((= i length) t)
+                (declare (fixnum i))
+                (unless (= (bit x i) (bit y i))
+                  (return nil)))))))
 
 (defun equal (x y)
   #!+sb-doc
diff --git a/src/code/target-char.lisp b/src/code/target-char.lisp
index 55b4bcc..0994977 100644
--- a/src/code/target-char.lisp
+++ b/src/code/target-char.lisp
@@ -518,7 +518,8 @@ is either numeric or alphabetic."
           (char-code ,ch)))))
 
 (defun two-arg-char-equal (c1 c2)
-  (= (equal-char-code c1) (equal-char-code c2)))
+  (or (eq c1 c2)
+      (= (equal-char-code c1) (equal-char-code c2))))
 
 (defun char-equal (character &rest more-characters)
   #!+sb-doc
diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp
index c1deb5a..4b9e766 100644
--- a/src/code/target-pathname.lisp
+++ b/src/code/target-pathname.lisp
@@ -267,19 +267,20 @@
 (defun pathname= (pathname1 pathname2)
   (declare (type pathname pathname1)
            (type pathname pathname2))
-  (and (eq (%pathname-host pathname1)
-           (%pathname-host pathname2))
-       (compare-component (%pathname-device pathname1)
-                          (%pathname-device pathname2))
-       (compare-component (%pathname-directory pathname1)
-                          (%pathname-directory pathname2))
-       (compare-component (%pathname-name pathname1)
-                          (%pathname-name pathname2))
-       (compare-component (%pathname-type pathname1)
-                          (%pathname-type pathname2))
-       (or (eq (%pathname-host pathname1) *unix-host*)
-           (compare-component (%pathname-version pathname1)
-                              (%pathname-version pathname2)))))
+  (or (eq pathname1 pathname2)
+      (and (eq (%pathname-host pathname1)
+               (%pathname-host pathname2))
+           (compare-component (%pathname-device pathname1)
+                              (%pathname-device pathname2))
+           (compare-component (%pathname-directory pathname1)
+                              (%pathname-directory pathname2))
+           (compare-component (%pathname-name pathname1)
+                              (%pathname-name pathname2))
+           (compare-component (%pathname-type pathname1)
+                              (%pathname-type pathname2))
+           (or (eq (%pathname-host pathname1) *unix-host*)
+               (compare-component (%pathname-version pathname1)
+                                  (%pathname-version pathname2))))))
 
 ;;; Convert PATHNAME-DESIGNATOR (a pathname, or string, or
 ;;; stream), into a pathname in pathname.
diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index d6546ce..433b153 100644
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -844,6 +844,7 @@
 (defknown hash-table-test (hash-table) symbol (foldable flushable))
 (defknown sxhash (t) hash (#-sb-xc-host foldable flushable))
 (defknown psxhash (t &optional t) hash (#-sb-xc-host foldable flushable))
+(defknown hash-table-equalp (hash-table hash-table) boolean (foldable flushable))
 
 ;;;; from the "Arrays" chapter
 
-- 
1.7.10.4