mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 14:21:10 +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)))) (values #f #f))))
(define-branch-folder-alias heap-numbers-equal? eq?) (define-branch-folder-alias heap-numbers-equal? eq?)
(define (compare-integer-ranges type0 min0 max0 type1 min1 max1) (define (compare-exact-ranges min0 max0 min1 max1)
(and (type<=? (logior type0 type1) (and (cond ((< max0 min1) '<)
(logior &exact-integer &s64 &u64))
(cond ((< max0 min1) '<)
((> min0 max1) '>) ((> min0 max1) '>)
((= min0 max0 min1 max1) '=) ((= min0 max0 min1 max1) '=)
((<= max0 min1) '<=) ((<= max0 min1) '<=)
@ -144,12 +142,18 @@
(else #f)))) (else #f))))
(define-binary-branch-folder (< type0 min0 max0 type1 min1 max1) (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 #t))
((= >= >) (values #t #f)) ((= >= >) (values #t #f))
(else (values #f #f)))) (else (values #f #f))))
(define-branch-folder-alias u64-< <) (define-branch-folder-alias s64-< u64-<)
(define-branch-folder-alias s64-< <)
;; We currently cannot define branch folders for floating point ;; We currently cannot define branch folders for floating point
;; comparison ops like the commented one below because we can't prove ;; comparison ops like the commented one below because we can't prove
;; there are no nans involved. ;; there are no nans involved.
@ -178,18 +182,24 @@
(define-branch-folder-alias imm-s64-< imm-u64-<) (define-branch-folder-alias imm-s64-< imm-u64-<)
(define-binary-branch-folder (= type0 min0 max0 type1 min1 max1) (define-binary-branch-folder (= type0 min0 max0 type1 min1 max1)
(if (and (type<=? (logior type0 type1) (cond
(logior &exact-integer &fraction)) ((not (type<=? (logior type0 type1) &exact-number))
(zero? (logand type0 type1))) (values #f #f))
;; If both values are exact but of different types, they are not ((zero? (logand type0 type1))
;; equal. ;; If both values are exact but of different types, they are not
(values #t #f) ;; equal.
(case (compare-integer-ranges type0 min0 max0 type1 min1 max1) (values #t #f))
((=) (values #t #t)) (else
((< >) (values #t #f)) (case (compare-exact-ranges min0 max0 min1 max1)
(else (values #f #f))))) ((=) (values #t #t))
(define-branch-folder-alias u64-= =) ((< >) (values #t #f))
(define-branch-folder-alias s64-= =) (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-=)