X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fconstraint.lisp;h=5056510d55b4756b01c393820dce424557bf928a;hb=179812c3ad5dad69239c625ec929a7d486cf568f;hp=79f19c1888d514d7f4932a83245ff4f4891fba1b;hpb=fb24d88c8f97f1b344addab398fc54f62d8aa4ce;p=sbcl.git

diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index 79f19c1..5056510 100644
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -427,6 +427,7 @@
          (when ,constraints
            (let ((,min (conset-min ,conset))
                  (,max (conset-max ,conset)))
+             (declare (optimize speed))
              (map nil (lambda (constraint)
                         (declare (type constraint constraint))
                         (let ((number (constraint-number constraint)))
@@ -941,6 +942,12 @@
        (binding* ((var (set-var node))
                   (nil (lambda-var-p var) :exit-if-null)
                   (nil (lambda-var-constraints var) :exit-if-null))
+         (when (policy node (and (= speed 3) (> speed compilation-speed)))
+           (let ((type (lambda-var-type var)))
+             (unless (eql *universal-type* type)
+               (do-eql-vars (other (var gen))
+                 (unless (eql other var)
+                   (conset-add-constraint gen 'typep other type nil))))))
          (conset-clear-lambda-var gen var)
          (let ((type (single-value-type (node-derived-type node))))
            (unless (eq type *universal-type*)