Optimize some comparison functions for EQ cases.
authorStas Boukarev <stassats@gmail.com>
Thu, 5 Sep 2013 14:35:12 +0000 (18:35 +0400)
committerStas Boukarev <stassats@gmail.com>
Thu, 5 Sep 2013 14:35:12 +0000 (18:35 +0400)
Add (or (eq x y) ...) to bit-vector-=, two-arg-char-equal, pathname=.

package-data-list.lisp-expr
src/code/pred.lisp
src/code/target-char.lisp
src/code/target-pathname.lisp
src/compiler/fndb.lisp

index d865cc9..c940681 100644 (file)
@@ -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"
index f167505..4a6703a 100644 (file)
 
 (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
index 55b4bcc..0994977 100644 (file)
@@ -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
index c1deb5a..4b9e766 100644 (file)
 (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.
index d6546ce..433b153 100644 (file)
 (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))
 \f
 ;;;; from the "Arrays" chapter