From 0dda5090b6c16a641000b4eb2dcd479f39b784ca Mon Sep 17 00:00:00 2001 From: Lutz Euler Date: Wed, 23 Nov 2011 20:31:09 +0100 Subject: [PATCH] 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. --- src/compiler/constraint.lisp | 12 ++++++++---- tests/compiler.pure.lisp | 25 +++++++++++++++++++++++++ 2 files changed, 33 insertions(+), 4 deletions(-) diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp index 5056510..fae2b81 100644 --- 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 --- 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 -- 1.7.10.4