1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00

Improve type and range inference on bignums

* module/language/cps/types.scm (bignum?): New predicate inferrer.
  (infer-integer-<, <, u64-<, s64-<): Factor out how integer comparisons
  are done.  Improve inference over bignums.
  (define-<-inferrer): Remove unused definition.
  (s64-=): Define inferrer; omitted before because of a typo.
  (define-binary-result!, abs): Fix up fixnum/bignum bits; before, we
  would lose some cases where fixnums could become bignums and vice
  versa.
  (define-unary-result!): Remove unused helper.
* module/language/cps/types.scm (bignum?): New folder.
This commit is contained in:
Andy Wingo 2017-11-22 15:36:26 +01:00
parent 6a11fb1532
commit 6f3ae92b37
2 changed files with 91 additions and 45 deletions

View file

@ -110,6 +110,7 @@
;; All the cases that are in compile-bytecode. ;; All the cases that are in compile-bytecode.
(define-unary-type-predicate-folder fixnum? &fixnum) (define-unary-type-predicate-folder fixnum? &fixnum)
(define-unary-type-predicate-folder bignum? &bignum)
(define-unary-type-predicate-folder pair? &pair) (define-unary-type-predicate-folder pair? &pair)
(define-unary-type-predicate-folder symbol? &symbol) (define-unary-type-predicate-folder symbol? &symbol)
(define-unary-type-predicate-folder variable? &box) (define-unary-type-predicate-folder variable? &box)

View file

@ -634,12 +634,28 @@ minimum, and maximum."
((<= (&max val) (target-most-positive-fixnum)) ((<= (&max val) (target-most-positive-fixnum))
(restrict! val &bignum -inf.0 (1- (target-most-negative-fixnum)))) (restrict! val &bignum -inf.0 (1- (target-most-negative-fixnum))))
((>= (&min val) (target-most-negative-fixnum)) ((>= (&min val) (target-most-negative-fixnum))
(restrict! val &bignum (target-most-positive-fixnum) +inf.0)) (restrict! val &bignum (1+ (target-most-positive-fixnum)) +inf.0))
(else (else
(restrict! val &bignum -inf.0 +inf.0)))) (restrict! val &bignum -inf.0 +inf.0))))
(else (else
(restrict! val (logand &all-types (lognot &fixnum)) -inf.0 +inf.0)))) (restrict! val (logand &all-types (lognot &fixnum)) -inf.0 +inf.0))))
(define-predicate-inferrer (bignum? val true?)
(cond
(true?
(cond
((<= (&max val) (target-most-positive-fixnum))
(restrict! val &bignum -inf.0 (1- (target-most-negative-fixnum))))
((>= (&min val) (target-most-negative-fixnum))
(restrict! val &bignum (1+ (target-most-positive-fixnum)) +inf.0))
(else
(restrict! val &bignum -inf.0 +inf.0))))
((type<=? (&type val) &exact-integer)
(restrict! val &fixnum
(target-most-negative-fixnum) (target-most-positive-fixnum)))
(else
(restrict! val (logand &all-types (lognot &bignum)) -inf.0 +inf.0))))
(define-syntax-rule (define-simple-predicate-inferrer predicate type) (define-syntax-rule (define-simple-predicate-inferrer predicate type)
(define-predicate-inferrer (predicate val true?) (define-predicate-inferrer (predicate val true?)
(let ((type (if true? (let ((type (if true?
@ -1006,34 +1022,53 @@ minimum, and maximum."
(restrict! a &domain min max) (restrict! a &domain min max)
(restrict! b &domain min max)))))) (restrict! b &domain min max))))))
(define-syntax-rule (define-<-inferrer (op &domain &integer-domain)) (define-syntax-rule (infer-integer-< a b true?)
(define-predicate-inferrer (op a b true?) (let ((min0 (&min a)) (max0 (&max a))
(let ((types (logior (&type a) (&type b)))) (min1 (&min b)) (max1 (&max b)))
(when (type<=? types &domain) (cond
(let ((int? (type<=? types &integer-domain)) (true?
(min0 (&min a)) (max0 (&max a)) (restrict! a &all-types min0 (min max0 (1- max1)))
(min1 (&min b)) (max1 (&max b))) (restrict! b &all-types (max (1+ min0) min1) max1))
(cond (else
(true? (restrict! a &all-types (max min0 min1) max0)
(restrict! a &domain (restrict! b &all-types min1 (min max0 max1))))))
min0
(min max0 (if int? (1- max1) max1)))
(restrict! b &domain
(max (if int? (1+ min0) min0) min1)
max1))
(else
(restrict! a &domain (max min0 min1) max0)
(restrict! b &domain min1 (min max0 max1)))))))))
(define-simple-type-checker (= &number &number)) (define-simple-type-checker (= &number &number))
(define-=-inferrer (= &number)) (define-=-inferrer (= &number))
(define-simple-type-checker (< &real &real)) (define-simple-type-checker (< &real &real))
(define-<-inferrer (< &real &exact-integer)) (define-predicate-inferrer (< a b true?)
(let ((types (logior (&type a) (&type b))))
(cond
((type<=? types &exact-integer)
(cond
((and (eqv? (&type a) &bignum) (eqv? (&type b) &fixnum))
(if true?
(restrict! a &bignum -inf.0 (1- (target-most-negative-fixnum)))
(restrict! a &bignum (1+ (target-most-positive-fixnum)) +inf.0)))
((and (eqv? (&type a) &fixnum) (eqv? (&type b) &bignum))
(if true?
(restrict! b &bignum (1+ (target-most-positive-fixnum)) +inf.0)
(restrict! b &bignum -inf.0 (1- (target-most-negative-fixnum)))))
(else
(infer-integer-< a b true?))))
(else
(let ((min0 (&min a)) (max0 (&max a))
(min1 (&min b)) (max1 (&max b)))
(cond
(true?
(restrict! a &real min0 (min max0 max1))
(restrict! b &real (max min0 min1) max1))
(else
(restrict! a &real (max min0 min1) max0)
(restrict! b &real min1 (min max0 max1)))))))))
(define-=-inferrer (u64-= &u64)) (define-=-inferrer (u64-= &u64))
(define-<-inferrer (u64-< &u64 &u64)) (define-predicate-inferrer (u64-< a b true?)
(infer-integer-< a b true?))
(define-<-inferrer (s64-< &s64 &s64)) (define-=-inferrer (s64-= &s64))
(define-predicate-inferrer (s64-< a b true?)
(infer-integer-< a b true?))
(define-predicate-inferrer/param (u64-imm-= b a true?) (define-predicate-inferrer/param (u64-imm-= b a true?)
(when true? (when true?
@ -1064,18 +1099,6 @@ minimum, and maximum."
;; not-a-number values. ;; not-a-number values.
;; Arithmetic. ;; Arithmetic.
(define-syntax-rule (define-unary-result! a-type$ result min$ max$)
(let ((min min$) (max max$) (type a-type$))
(cond
((not (type<=? type &number))
;; Not definitely a number. Punt and do nothing.
(define! result &all-types -inf.0 +inf.0))
;; Complex numbers don't have a range.
((eqv? type &complex)
(define! result &complex -inf.0 +inf.0))
(else
(define! result type min max)))))
(define-syntax-rule (define-binary-result! a-type$ b-type$ result closed? (define-syntax-rule (define-binary-result! a-type$ b-type$ result closed?
min$ max$) min$ max$)
(let* ((min min$) (max max$) (a-type a-type$) (b-type b-type$) (let* ((min min$) (max max$) (a-type a-type$) (b-type b-type$)
@ -1104,7 +1127,21 @@ minimum, and maximum."
;; Integers may become fractions under division. ;; Integers may become fractions under division.
(type (if (or closed? (zero? (logand type &exact-integer))) (type (if (or closed? (zero? (logand type &exact-integer)))
type type
(logior type &fraction)))) (logior type &fraction)))
;; Fixnums and bignums may become each other, depending on
;; the range.
(type (cond
((zero? (logand type &exact-integer))
type)
((<= (target-most-negative-fixnum)
min max
(target-most-positive-fixnum))
(logand type (lognot &bignum)))
((or (< max (target-most-negative-fixnum))
(> min (target-most-positive-fixnum)))
(logand type (lognot &fixnum)))
(else
(logior type &fixnum &bignum)))))
(define! result type min max)))))) (define! result type min max))))))
(define-simple-type-checker (add &number &number)) (define-simple-type-checker (add &number &number))
@ -1624,17 +1661,25 @@ minimum, and maximum."
(define-type-inferrer (abs x result) (define-type-inferrer (abs x result)
(let ((type (&type x))) (let ((type (&type x)))
(cond (cond
((eqv? type (logand type &number)) ((type<=? type &exact-integer)
(restrict! x &real -inf.0 +inf.0) (if (< (&min x) 0)
(define! result (logand type &real) (define-exact-integer! result 0 (max (abs (&min x)) (abs (&max x))))
(min (abs (&min x)) (abs (&max x))) (define! result type (&min x) (&max x))))
(max (abs (&min x)) (abs (&max x)))))
(else (else
(define! result (logior (logand (&type x) (lognot &number)) (when (type<=? type &number)
(logand (&type x) &real)) (restrict! x &real -inf.0 +inf.0))
(&min/0 x) (let* ((min (if (< (&min x) 0) 0 (&min x)))
(max (abs (&min x)) (abs (&max x)))))))) (max (max (abs (&min x)) (abs (&max x))))
(type (cond
((not (logtest type &exact-integer)) type)
((< (target-most-positive-fixnum) min)
(logior &bignum (logand type (lognot &fixnum))))
((<= max (target-most-positive-fixnum))
(logior &fixnum (logand type (lognot &bignum))))
(else (logior type &fixnum &bignum)))))
(define! result (logior (logand type (lognot &number))
(logand type &real))
min max))))))