1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-03 16:20:39 +02:00

Precise range inference on <, <=, >=, > branches

* module/language/cps/types.scm (restricted-comparison-ranges): New
  helper.
  (define-comparison-inferrer): New helper.
  (<, <=, >=, >): Infer ranges precisely.
This commit is contained in:
Andy Wingo 2015-03-31 11:13:01 +02:00
parent ef7a71b768
commit 4ce1857019

View file

@ -723,12 +723,44 @@ minimum, and maximum."
(restrict! a &number min max)
(restrict! b &number min max))))
(define-simple-type-checker (< &real &real))
(define-predicate-inferrer (< a b true?)
(define (restricted-comparison-ranges op type0 min0 max0 type1 min1 max1)
(define (infer-integer-ranges)
(match op
('< (values min0 (min max0 (1- max1)) (max (1+ min0) min1) max1))
('<= (values min0 (min max0 max1) (max min0 min1) max1))
('>= (values (max min0 min1) max0 min1 (min max0 max1)))
('> (values (max min0 (1+ min1)) max0 min1 (min (1- max0) max1)))))
(define (infer-real-ranges)
(match op
((or '< '<=) (values min0 (min max0 max1) (max min0 min1) max1))
((or '> '>=) (values (max min0 min1) max0 min1 (min max0 max1)))))
(if (= (logior type0 type1) &exact-integer)
(infer-integer-ranges)
(infer-real-ranges)))
(define-syntax-rule (define-comparison-inferrer (op inverse))
(define-predicate-inferrer (op a b true?)
(when (zero? (logand (logior (&type a) (&type b)) (lognot &number)))
(restrict! a &real -inf.0 +inf.0)
(restrict! b &real -inf.0 +inf.0)))
(define-type-aliases < <= > >=)
(call-with-values
(lambda ()
(restricted-comparison-ranges (if true? 'op 'inverse)
(&type a) (&min a) (&max a)
(&type b) (&min b) (&max b)))
(lambda (min0 max0 min1 max1)
(restrict! a &real min0 max0)
(restrict! b &real min1 max1))))))
(define-simple-type-checker (< &real &real))
(define-comparison-inferrer (< >=))
(define-simple-type-checker (<= &real &real))
(define-comparison-inferrer (<= >))
(define-simple-type-checker (>= &real &real))
(define-comparison-inferrer (>= <))
(define-simple-type-checker (> &real &real))
(define-comparison-inferrer (> <=))
;; Arithmetic.
(define-syntax-rule (define-unary-result! a result min max)