From 3ceaa081c90a970f6779e02bed659835a202772c Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Wed, 28 Dec 2005 22:37:14 +0000 Subject: [PATCH] 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 --- NEWS | 3 ++ package-data-list.lisp-expr | 2 +- src/code/numbers.lisp | 33 --------------------- src/code/pred.lisp | 67 ++++++++++++++++++++++++++++++++++--------- version.lisp-expr | 2 +- 5 files changed, 59 insertions(+), 48 deletions(-) diff --git a/NEWS b/NEWS index 8f25905..dc9abda 100644 --- 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 --- 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 --- 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)))))))))) ;;;; logicals diff --git a/src/code/pred.lisp b/src/code/pred.lisp index dc78044..a3d18bd 100644 --- 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 --- 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" -- 1.7.10.4