[Guile-commits] 01/03: Don't fold comparisons that might contain a NaN.

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 4a0a930f1c6f3d34bbd5bd9877042de368b9c196
Author: Andy Wingo <address@hidden>
Date:   Tue Nov 14 10:40:02 2017 +0100

    Don't fold comparisons that might contain a NaN.
    
    * module/language/cps/type-fold.scm (compare-integer-ranges): Rename
      from compare-ranges, as we can't compare ranges that might include a
      NaN.
      (<, =): Update uses.
---
 module/language/cps/type-fold.scm | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

diff --git a/module/language/cps/type-fold.scm 
b/module/language/cps/type-fold.scm
index 999bb5f..27b9dd8 100644
--- a/module/language/cps/type-fold.scm
+++ b/module/language/cps/type-fold.scm
@@ -128,10 +128,9 @@
     (values #f #f))))
 (define-branch-folder-alias heap-numbers-equal? eq?)
 
-(define (compare-ranges type0 min0 max0 type1 min1 max1)
-  ;; Since &real, &u64, and &f64 are disjoint, we can compare once
-  ;; against their mask instead of doing three "or" comparisons.
-  (and (zero? (logand (logior type0 type1) (lognot (logior &real &f64 &u64))))
+(define (compare-integer-ranges type0 min0 max0 type1 min1 max1)
+  (and (type<=? (logior type0 type1)
+                (logior &exact-integer &s64 &u64))
        (cond ((< max0 min1) '<)
              ((> min0 max1) '>)
              ((= min0 max0 min1 max1) '=)
@@ -140,7 +139,7 @@
              (else #f))))
 
 (define-binary-branch-folder (< type0 min0 max0 type1 min1 max1)
-  (case (compare-ranges type0 min0 max0 type1 min1 max1)
+  (case (compare-integer-ranges type0 min0 max0 type1 min1 max1)
     ((<) (values #t #t))
     ((= >= >) (values #t #f))
     (else (values #f #f))))
@@ -153,7 +152,7 @@
 ;; (define-branch-folder-alias f64-< <)
 
 (define-binary-branch-folder (= type0 min0 max0 type1 min1 max1)
-  (case (compare-ranges type0 min0 max0 type1 min1 max1)
+  (case (compare-integer-ranges type0 min0 max0 type1 min1 max1)
     ((=) (values #t #t))
     ((< >) (values #t #f))
     (else (values #f #f))))