Tighter floating-point type constraints in some cases

CONSTRAIN-FLOAT-TYPE used to return a closed bound in some cases where
the corresponding (tighter) open bound would have been derivable,
leading to missed optimisation opportunities. For example the compiler
did not derive that x is not zero in the following call to LOG:

(defun foo (x)
  (declare (type (single-float 0.0) x))
  (when (> x 0.0)
    (log x)))

Fix CONSTRAIN-FLOAT-TYPE so that it returns the tightest possible result
in all cases.

See lp#894498 for details.

diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index 5056510..fae2b81 100644 (file)
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -739,6 +739,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
@@ -760,10 +765,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

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 1712620..3e48e39 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -2082,6 +2082,31 @@
       (compiler-note () (throw :note nil)))
     (error "Unreachable code undetected.")))
 
+(with-test (:name (:compiler :constraint-propagation :float-bounds-3
+                   :LP-894498))
+  (catch :note
+    (handler-case
+        (compile nil '(lambda (x)
+                        (declare (type (single-float 0.0) x))
+                        (when (> x 0.0)
+                          (when (zerop x)
+                            (error "This is unreachable.")))))
+      (compiler-note () (throw :note nil)))
+    (error "Unreachable code undetected.")))
+
+(with-test (:name (:compiler :constraint-propagation :float-bounds-4
+                   :LP-894498))
+  (catch :note
+    (handler-case
+        (compile nil '(lambda (x y)
+                        (declare (type (single-float 0.0) x)
+                                 (type (single-float (0.0)) y))
+                        (when (> x y)
+                          (when (zerop x)
+                            (error "This is unreachable.")))))
+      (compiler-note () (throw :note nil)))
+    (error "Unreachable code undetected.")))
+
 (with-test (:name (:compiler :constraint-propagation :var-eql-to-var-1))
   (catch :note
     (handler-case