From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sun, 7 Nov 2010 01:18:29 +0000 (+0000)
Subject: 1.0.44.2: don't add pointless TYPEP T constraints
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=33a45339444f8418c8c537c43d59fc3d5ea3098b;p=sbcl.git

1.0.44.2: don't add pointless TYPEP T constraints

  Pointless constraints are not only pointless, they also slow things
  down for no good reason.
---

diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index eb936ba..a32c5a9 100644
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -761,11 +761,11 @@
                  for var in (lambda-vars fun)
                  and val in (combination-args call)
                  when (and val (lambda-var-constraints var))
-                 do (let* ((type (lvar-type val))
-                           (con (find-or-create-constraint 'typep var type
-                                                           nil)))
-                      (conset-adjoin con gen))
-                 (maybe-add-eql-var-var-constraint var val gen)))))
+                 do (let ((type (lvar-type val)))
+                      (unless (eq type *universal-type*)
+                        (let ((con (find-or-create-constraint 'typep var type nil)))
+                          (conset-adjoin con gen))))
+                    (maybe-add-eql-var-var-constraint var val gen)))))
       (ref
        (when (ok-ref-lambda-var node)
          (maybe-add-eql-var-lvar-constraint node gen)
@@ -778,17 +778,19 @@
          (let ((var (ok-lvar-lambda-var lvar gen)))
            (when var
              (let ((atype (single-value-type (cast-derived-type node)))) ;FIXME
-               (do-eql-vars (var (var gen))
-                 (let ((con (find-or-create-constraint 'typep var atype nil)))
-                   (conset-adjoin con gen))))))))
+               (unless (eq atype *universal-type*)
+                 (do-eql-vars (var (var gen))
+                   (let ((con (find-or-create-constraint 'typep var atype nil)))
+                     (conset-adjoin con gen)))))))))
       (cset
        (binding* ((var (set-var node))
                   (nil (lambda-var-p var) :exit-if-null)
                   (cons (lambda-var-constraints var) :exit-if-null))
          (conset-difference gen cons)
-         (let* ((type (single-value-type (node-derived-type node)))
-                (con (find-or-create-constraint 'typep var type nil)))
-           (conset-adjoin con gen))
+         (let ((type (single-value-type (node-derived-type node))))
+           (unless (eq type *universal-type*)
+             (let ((con (find-or-create-constraint 'typep var type nil)))
+               (conset-adjoin con gen))))
          (maybe-add-eql-var-var-constraint var (set-value node) gen)))))
   gen)
 
diff --git a/version.lisp-expr b/version.lisp-expr
index 3707069..1fe853e 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".)
-"1.0.44.1"
+"1.0.44.2"