mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

Integer comparison folding refactors

Browse source 
* module/language/cps/type-fold.scm (compare-exact-ranges): Rename from
  compare-integer-ranges.
  (<, u64-<, s64-<, =, u64-=, s64-=): Separate the generic and unboxed
  implementations.
This commit is contained in:
Andy Wingo 2017-12-02 20:43:01 +01:00
parent 8c37cf083f
commit 40dac99d42
1 changed files with 29 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

48
module/language/cps/type-fold.scm
View file

@ -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-=)