[Guile-commits] 03/04: Integer comparison folding refactors

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 40dac99d42105d1c6bcb7e4738f7b3449c549cf1
Author: Andy Wingo <address@hidden>
Date:   Sat Dec 2 20:43:01 2017 +0100

    Integer comparison folding refactors
    
    * module/language/cps/type-fold.scm (compare-exact-ranges): Rename from
      compare-integer-ranges.
      (<, u64-<, s64-<, =, u64-=, s64-=): Separate the generic and unboxed
      implementations.
---
 module/language/cps/type-fold.scm | 48 +++++++++++++++++++++++----------------
 1 file changed, 29 insertions(+), 19 deletions(-)

diff --git a/module/language/cps/type-fold.scm 
b/module/language/cps/type-fold.scm
index cd928e7..f4e24f4 100644
--- a/module/language/cps/type-fold.scm
+++ b/module/language/cps/type-fold.scm
@@ -133,10 +133,8 @@
     (values #f #f))))
 (define-branch-folder-alias heap-numbers-equal? eq?)
 
-(define (compare-integer-ranges type0 min0 max0 type1 min1 max1)
-  (and (type<=? (logior type0 type1)
-                (logior &exact-integer &s64 &u64))
-       (cond ((< max0 min1) '<)
+(define (compare-exact-ranges min0 max0 min1 max1)
+  (and (cond ((< max0 min1) '<)
              ((> min0 max1) '>)
              ((= min0 max0 min1 max1) '=)
              ((<= max0 min1) '<=)
@@ -144,12 +142,18 @@
              (else #f))))
 
 (define-binary-branch-folder (< type0 min0 max0 type1 min1 max1)
-  (case (compare-integer-ranges type0 min0 max0 type1 min1 max1)
+  (if (type<=? (logior type0 type1) &exact-number)
+      (case (compare-exact-ranges min0 max0 min1 max1)
+        ((<) (values #t #t))
+        ((= >= >) (values #t #f))
+        (else (values #f #f)))
+      (values #f #f)))
+(define-binary-branch-folder (u64-< type0 min0 max0 type1 min1 max1)
+  (case (compare-exact-ranges min0 max0 min1 max1)
     ((<) (values #t #t))
     ((= >= >) (values #t #f))
     (else (values #f #f))))
-(define-branch-folder-alias u64-< <)
-(define-branch-folder-alias s64-< <)
+(define-branch-folder-alias s64-< u64-<)
 ;; We currently cannot define branch folders for floating point
 ;; comparison ops like the commented one below because we can't prove
 ;; there are no nans involved.
@@ -178,18 +182,24 @@
 (define-branch-folder-alias imm-s64-< imm-u64-<)
 
 (define-binary-branch-folder (= type0 min0 max0 type1 min1 max1)
-  (if (and (type<=? (logior type0 type1)
-                    (logior &exact-integer &fraction))
-           (zero? (logand type0 type1)))
-      ;; If both values are exact but of different types, they are not
-      ;; equal.
-      (values #t #f)
-      (case (compare-integer-ranges type0 min0 max0 type1 min1 max1)
-        ((=) (values #t #t))
-        ((< >) (values #t #f))
-        (else (values #f #f)))))
-(define-branch-folder-alias u64-= =)
-(define-branch-folder-alias s64-= =)
+  (cond
+   ((not (type<=? (logior type0 type1) &exact-number))
+    (values #f #f))
+   ((zero? (logand type0 type1))
+    ;; If both values are exact but of different types, they are not
+    ;; equal.
+    (values #t #f))
+   (else
+    (case (compare-exact-ranges min0 max0 min1 max1)
+      ((=) (values #t #t))
+      ((< >) (values #t #f))
+      (else (values #f #f))))))
+(define-binary-branch-folder (u64-= type0 min0 max0 type1 min1 max1)
+  (case (compare-exact-ranges min0 max0 min1 max1)
+    ((=) (values #t #t))
+    ((< >) (values #t #f))
+    (else (values #f #f))))
+(define-branch-folder-alias s64-= u64-=)