From 40dac99d42105d1c6bcb7e4738f7b3449c549cf1 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sat, 2 Dec 2017 20:43:01 +0100 Subject: [PATCH] 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 cd928e743..f4e24f48c 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-=)