[Sbcl-commits] master: Optimize typep on undefined types.

[stassats <sta...@us...>]

The branch "master" has been updated in SBCL:
       via  a0e47f715207998bbaeab0c429c6454525eec48e (commit)
      from  f251e070cbef5735cd0d7a17d648c60c8101717a (commit)

- Log -----------------------------------------------------------------
commit a0e47f715207998bbaeab0c429c6454525eec48e
Author: Stas Boukarev <sta...@gm...>
Date:   Sat Dec 3 03:15:24 2016 +0300

    Optimize typep on undefined types.
    
    (typep x 'later-define-class) is fairly common, use an inline cache
    for constant but undefined types.
    Specially optimize the classoid case, call %%typep for others but with a
    parsed ctype.
    Makes it just as fast for classes, much faster for structures, and
    quite faster for non-classoid stuff coming from DEFTYPE.
    
    Closes lp#1082967.
---
 NEWS                       |    2 ++
 src/code/typep.lisp        |   29 +++++++++++++++++++++++++++++
 src/compiler/typetran.lisp |    6 +++++-
 3 files changed, 36 insertions(+), 1 deletions(-)

diff --git a/NEWS b/NEWS
index 0b8ad3f..e901812 100644
--- a/NEWS
+++ b/NEWS
@@ -5,6 +5,8 @@ changes relative to sbcl-1.3.12:
     (lp#1645152)
   * enhancement: new Windows specific option to run-program, :escape-arguments
     (lp#1503496)
+  * optimization: faster TYPEP on undefined at compile-time types and upcoming
+    class definitions. (lp#1082967)
   * bug fix: get-timezone returns corret DST on 64-bit Windows. (lp#1641058)
 
 changes in sbcl-1.3.12 relative to sbcl-1.3.11:
diff --git a/src/code/typep.lisp b/src/code/typep.lisp
index cb9a8b1..1131645 100644
--- a/src/code/typep.lisp
+++ b/src/code/typep.lisp
@@ -199,6 +199,35 @@
          (and (functionp object)
               (csubtypep (specifier-type (sb!impl::%fun-type object)) type))))))
 
+(defun cached-typep (cache object)
+  (let* ((type (cdr cache))
+         (ctype (if (ctype-p type)
+                    type
+                    (specifier-type type))))
+    (if (unknown-type-p ctype)
+        (%%typep object ctype)
+        ;; Most of the time an undefined type becomes defined is
+        ;; through structure or class definition, optimize that case
+        (let ((fun
+                (if (classoid-p ctype)
+                    (lambda (cache object)
+                      ;; TODO: structures can be optimized even further
+                      (block nil
+                        (classoid-typep
+                         (typecase object
+                           (instance (%instance-layout object))
+                           (funcallable-instance
+                            (%funcallable-instance-layout object))
+                           (t (return)))
+                         (cdr (truly-the cons cache))
+                         object)))
+                    (lambda (cache object)
+                      (%%typep object (cdr (truly-the cons cache)))))))
+          (setf (cdr cache) ctype)
+          (sb!thread:barrier (:write))
+          (setf (car cache) fun)
+          (funcall fun cache object)))))
+
 ;;; Do a type test from a class cell, allowing forward reference and
 ;;; redefinition.
 (defun classoid-cell-typep (cell object)
diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index 90932e4..ac3b8a3 100644
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -305,7 +305,11 @@
            (when (policy *lexenv* (> speed inhibit-warnings))
              (compiler-notify "can't open-code test of unknown type ~S"
                               (type-specifier type)))
-           `(%typep ,object ',spec))
+           `(let ((object ,object)
+                  (cache (load-time-value (cons #'sb!kernel::cached-typep ',spec)
+                                          t)))
+              (funcall (truly-the function (car (truly-the cons cache)))
+                       cache object)))
           (t
            (ecase (first spec)
              (satisfies

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL