0.9.8.3:

	Make EQUAL faster (about 50% improvement for short lists on x86-64).
        As amazing as it might seem, there are actually real-world
        applications where significant time is spent in EQUAL.

        * Inline EQL in EQUAL
        * Rearrange things a bit to enable the inlining
        * Rewrite EQUAL to use a local helper function

diff --git a/NEWS b/NEWS
index 8f25905..dc9abda 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,4 +1,7 @@
 ;;;; -*- coding: utf-8; -*-
+changes in sbcl-0.9.9 relative to sbcl-0.9.8:
+  * optimization: faster implementation of EQUAL
+
 changes in sbcl-0.9.8 relative to sbcl-0.9.7:
   * minor incompatible change: (SETF CLASS-NAME) and (SETF
     GENERIC-FUNCTION-NAME) are generic functions once more (reverting

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 80006e6..3894252 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1114,7 +1114,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
                "%CHECK-BOUND" "%CHECK-VECTOR-SEQUENCE-BOUNDS"
                "%CLOSURE-FUN" "%CLOSURE-INDEX-REF" "%COS" "%COS-QUICK"
                "%COSH" "%DATA-VECTOR-AND-INDEX" "%DEPOSIT-FIELD"
-               "%DOUBLE-FLOAT" "%DPB" "%EXP" "%EXPM1" "%FIND-POSITION"
+               "%DOUBLE-FLOAT" "%DPB" "%EQL" "%EXP" "%EXPM1" "%FIND-POSITION"
                "%FIND-POSITION-VECTOR-MACRO" "%FIND-POSITION-IF"
                "%FIND-POSITION-IF-VECTOR-MACRO" "%FIND-POSITION-IF-NOT"
                "%FIND-POSITION-IF-NOT-VECTOR-MACRO" "%FUN-DOC"

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index caafd1b..fe0ff5c 100644 (file)
--- a/src/code/numbers.lisp
+++ b/src/code/numbers.lisp
@@ -969,39 +969,6 @@ the first."
     ((complex (or float rational))
      (and (= (realpart x) y)
           (zerop (imagpart x))))))
-
-(defun eql (obj1 obj2)
-  #!+sb-doc
-  "Return T if OBJ1 and OBJ2 represent the same object, otherwise NIL."
-  (or (eq obj1 obj2)
-      (if (or (typep obj2 'fixnum)
-              (not (typep obj2 'number)))
-          nil
-          (macrolet ((foo (&rest stuff)
-                       `(typecase obj2
-                          ,@(mapcar (lambda (foo)
-                                      (let ((type (car foo))
-                                            (fn (cadr foo)))
-                                        `(,type
-                                          (and (typep obj1 ',type)
-                                               (,fn obj1 obj2)))))
-                                    stuff))))
-            (foo
-              (single-float eql)
-              (double-float eql)
-              #!+long-float
-              (long-float eql)
-              (bignum
-               (lambda (x y)
-                 (zerop (bignum-compare x y))))
-              (ratio
-               (lambda (x y)
-                 (and (eql (numerator x) (numerator y))
-                      (eql (denominator x) (denominator y)))))
-              (complex
-               (lambda (x y)
-                 (and (eql (realpart x) (realpart y))
-                      (eql (imagpart x) (imagpart y))))))))))
 \f
 ;;;; logicals
 

diff --git a/src/code/pred.lisp b/src/code/pred.lisp
index dc78044..a3d18bd 100644 (file)
--- a/src/code/pred.lisp
+++ b/src/code/pred.lisp
@@ -160,6 +160,43 @@
   "Return T if OBJ1 and OBJ2 are the same object, otherwise NIL."
   (eq obj1 obj2))
 
+(declaim (inline %eql))
+(defun %eql (obj1 obj2)
+  #!+sb-doc
+  "Return T if OBJ1 and OBJ2 represent the same object, otherwise NIL."
+  (or (eq obj1 obj2)
+      (if (or (typep obj2 'fixnum)
+              (not (typep obj2 'number)))
+          nil
+          (macrolet ((foo (&rest stuff)
+                       `(typecase obj2
+                          ,@(mapcar (lambda (foo)
+                                      (let ((type (car foo))
+                                            (fn (cadr foo)))
+                                        `(,type
+                                          (and (typep obj1 ',type)
+                                               (,fn obj1 obj2)))))
+                                    stuff))))
+            (foo
+             (single-float eql)
+             (double-float eql)
+             #!+long-float
+             (long-float eql)
+             (bignum
+              (lambda (x y)
+                (zerop (bignum-compare x y))))
+             (ratio
+              (lambda (x y)
+                (and (eql (numerator x) (numerator y))
+                     (eql (denominator x) (denominator y)))))
+             (complex
+              (lambda (x y)
+                (and (eql (realpart x) (realpart y))
+                     (eql (imagpart x) (imagpart y))))))))))
+
+(defun eql (x y)
+  (%eql x y))
+
 (defun bit-vector-= (x y)
   (declare (type bit-vector x y))
   (if (and (simple-bit-vector-p x)
@@ -179,19 +216,23 @@
   whose elements are EQUAL. Strings and bit-vectors are EQUAL if they
   are the same length and have identical components. Other arrays must be
   EQ to be EQUAL."
-  (cond ((eql x y) t)
-        ((consp x)
-         (and (consp y)
-              (equal (car x) (car y))
-              (equal (cdr x) (cdr y))))
-        ((stringp x)
-         (and (stringp y) (string= x y)))
-        ((pathnamep x)
-         (and (pathnamep y) (pathname= x y)))
-        ((bit-vector-p x)
-         (and (bit-vector-p y)
-              (bit-vector-= x y)))
-        (t nil)))
+  (labels ((equal-aux (x y)
+             (cond ((%eql x y)
+                    t)
+                   ((consp x)
+                    (and (consp y)
+                         (equal-aux (car x) (car y))
+                         (equal-aux (cdr x) (cdr y))))
+                   ((stringp x)
+                    (and (stringp y) (string= x y)))
+                   ((pathnamep x)
+                    (and (pathnamep y) (pathname= x y)))
+                   ((bit-vector-p x)
+                    (and (bit-vector-p y)
+                         (bit-vector-= x y)))
+                   (t nil))))
+    (declare (maybe-inline equal-aux))
+    (equal-aux x y)))
 
 ;;; EQUALP comparison of HASH-TABLE values
 (defun hash-table-equalp (x y)

diff --git a/version.lisp-expr b/version.lisp-expr
index 8e32c02..4cb1442 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,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".)
-"0.9.8.2"
+"0.9.8.3"