1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-20 10:40:19 +02:00

Better range inference

* module/language/cps/types.scm (&fx32-min, &fx32-max, &fx64-min)
  (&fx64-max): New internal definitions.
* module/language/cps/types.scm (type-entry-saturating-union): Add more
  stops as we saturate ranges towards infinity.
This commit is contained in:
Andy Wingo 2017-11-13 14:31:36 +01:00
parent a88614fb17
commit dae0004627

View file

@ -220,6 +220,10 @@
(var (identifier? #'var) (var (identifier? #'var)
(datum->syntax #'var val))))))) (datum->syntax #'var val)))))))
(define-compile-time-value &fx32-min (- #x20000000))
(define-compile-time-value &fx32-max #x1fffFFFF)
(define-compile-time-value &fx64-min (- #x2000000000000000))
(define-compile-time-value &fx64-max #x1fffFFFFffffFFFF)
(define-compile-time-value &s64-min (- #x8000000000000000)) (define-compile-time-value &s64-min (- #x8000000000000000))
(define-compile-time-value &s64-max #x7fffFFFFffffFFFF) (define-compile-time-value &s64-max #x7fffFFFFffffFFFF)
(define-compile-time-value &u64-max #xffffFFFFffffFFFF) (define-compile-time-value &u64-max #xffffFFFFffffFFFF)
@ -297,12 +301,17 @@
(cond (cond
((not (< b-min a-min)) a-min) ((not (< b-min a-min)) a-min)
((< 0 b-min) 0) ((< 0 b-min) 0)
((< &fx32-min b-min) &fx32-min)
((< &fx64-min b-min) &fx64-min)
((< &range-min b-min) &range-min) ((< &range-min b-min) &range-min)
(else -inf.0))) (else -inf.0)))
(let ((a-max (type-entry-max a)) (let ((a-max (type-entry-max a))
(b-max (type-entry-max b))) (b-max (type-entry-max b)))
(cond (cond
((not (> b-max a-max)) a-max) ((not (> b-max a-max)) a-max)
((> &fx32-max b-max) &fx32-max)
((> &fx64-max b-max) &fx64-max)
((> &s64-max b-max) &s64-max)
((> &range-max b-max) &range-max) ((> &range-max b-max) &range-max)
(else +inf.0))))))) (else +inf.0)))))))