Fix EQL constraint propagation on constant assigned closure variables

[sbcl.git] / src / compiler / constraint.lisp

diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index 88a8252..550f9b9 100644 (file)
--- 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)))
@@ -584,7 +585,7 @@
     (precise-add-test-constraint fun x y not-p constraints
                                 consequent-constraints)
     (precise-add-test-constraint fun x y (not not-p) constraints
-                         alternative-constraints))
+                                 alternative-constraints))
   (values))
 
 (defun quick-add-complement-constraints (fun x y not-p
@@ -668,10 +669,7 @@
                            (add 'eql var1 var2 nil))
                           ((constant-lvar-p arg2)
                            (add 'eql var1
-                                (let ((use (principal-lvar-use arg2)))
-                                  (if (ref-p use)
-                                      (ref-leaf use)
-                                      (find-constant (lvar-value arg2))))
+                                (find-constant (lvar-value arg2))
                                 nil))
                           (t
                            (add-test-constraint quick-p
@@ -738,6 +736,11 @@
        (eq (numeric-type-complexp x) :real)))
 
 ;;; Exactly the same as CONSTRAIN-INTEGER-TYPE, but for float numbers.
+;;;
+;;; In contrast to the integer version, here the input types can have
+;;; open bounds in addition to closed ones and we don't increment or
+;;; decrement a bound to honor OR-EQUAL being NIL but put an open bound
+;;; into the result instead, if appropriate.
 (defun constrain-float-type (x y greater or-equal)
   (declare (type numeric-type x y))
   (declare (ignorable x y greater or-equal)) ; for CROSS-FLOAT-INFINITY-KLUDGE
@@ -759,10 +762,9 @@
            (tighter-p (x ref)
              (cond ((null x) nil)
                    ((null ref) t)
-                   ((and or-equal
-                         (= (type-bound-number x) (type-bound-number ref)))
-                    ;; X is tighter if REF is not an open bound and X is
-                    (and (not (consp ref)) (consp x)))
+                   ((= (type-bound-number x) (type-bound-number ref))
+                    ;; X is tighter if X is an open bound and REF is not
+                    (and (consp x) (not (consp ref))))
                    (greater
                     (< (type-bound-number ref) (type-bound-number x)))
                    (t