1.0.15.11: one more slice of ASSOC micro-optimization

 * In %ASSOC and %ASSOC-EQ, test for equality before checking if the
   list element is NIL: in the common case only one element needs both
   tests, and even in the rare cases (looking for NIL, list contains
   several NILs) this is as fast as the old version. Common cases
   improved by ~30% by this.

   Now, finally, CL:ASSOC is as fast as

    (defun fast-assoc (item list)
      (loop for e in list
            when (eq item (car e))
            return e))

   when the type of ITEM is known to be (OR FIXNUM (NOT NUMBER)).

 * In others %ASSOC-* functions, test for existence of element only
   once (the compiler should eliminate the redundant test, though, but
   this is cleaner.)

diff --git a/src/code/list.lisp b/src/code/list.lisp
index f7537f3..9f649a4 100644 (file)
--- a/src/code/list.lisp
+++ b/src/code/list.lisp
@@ -1217,34 +1217,44 @@
 
 ;;;; Specialized versions
 
-;;; %MEMBER-* and %ASSOC-* function. The transforms for %MEMBER and
-;;; %ASSOC pick the appropriate version. These win because they have
-;;; only positional arguments, the TEST & KEY functions are known to
-;;; exist (or not), and are known to be functions, not function
-;;; designators.
-(macrolet ((def (funs form &optional variant)
-             (flet ((%def (name)
-                      `(defun ,(intern (format nil "%~A~{-~A~}~@[-~A~]" name funs variant))
-                           (item list ,@funs)
-                         (declare (optimize speed))
-                         ,@(when funs `((declare (function ,@funs))))
-                         (do ((list list (cdr list)))
-                             ((null list) nil)
-                           (declare (list list))
-                           (let ((this (car list)))
-                             ,(ecase name
-                                     (assoc
-                                      `(when this
-                                         (let ((target (car this)))
-                                           (when (and this ,form)
-                                             (return this)))))
-                                     (member
-                                      `(let ((target this))
+;;; %MEMBER-* and %ASSOC-* functions. The transforms for MEMBER and
+;;; ASSOC pick the appropriate version. These win because they have
+;;; only positional arguments, the TEST, TEST-NOT & KEY functions are
+;;; known to exist (or not), and are known to be functions instead of
+;;; function designators. We are also able to transform many common
+;;; cases to -EQ versions, which are substantially faster then EQL
+;;; using ones.
+(macrolet
+    ((def (funs form &optional variant)
+       (flet ((%def (name)
+                `(defun ,(intern (format nil "%~A~{-~A~}~@[-~A~]" name funs variant))
+                     (item list ,@funs)
+                   (declare (optimize speed))
+                   ,@(when funs `((declare (function ,@funs))))
+                   (do ((list list (cdr list)))
+                       ((null list) nil)
+                     (declare (list list))
+                     (let ((this (car list)))
+                       ,(ecase name
+                               (assoc
+                                (if funs
+                                    `(when this
+                                       (let ((target (car this)))
                                          (when ,form
-                                           (return list))))))))))
-               `(progn
-                  ,(%def 'member)
-                  ,(%def 'assoc)))))
+                                           (return this))))
+                                    ;; If there is no TEST/TEST-NOT or
+                                    ;; KEY, do the EQ/EQL test first,
+                                    ;; before checking for NIL.
+                                    `(let ((target (car this)))
+                                       (when (and ,form this)
+                                         (return this)))))
+                               (member
+                                `(let ((target this))
+                                   (when ,form
+                                     (return list))))))))))
+         `(progn
+            ,(%def 'member)
+            ,(%def 'assoc)))))
   (def ()
       (eql item target))
   (def ()

diff --git a/version.lisp-expr b/version.lisp-expr
index a066fe4..cfbefd6 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".)
-"1.0.15.10"
+"1.0.15.11"