mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-23 04:50:28 +02:00
Code Activity

Type inference distinguishes &fixnum and &bignum types

Browse source 
This will allow heap-object? / inum? predicates to do something useful.

* module/language/cps/types.scm (&fixnum, &bignum): Split &exact-integer
  into these types.  Keep &exact-integer as a union type.
  (type<=?): New helper.
  (constant-type): Return &fixnum or &bignum as appropriate.
  (define-exact-integer!): New helper, tries to make exact integer
  results be &fixnum if they are within range.  Adapt users.
  (restricted-comparison-ranges, define-binary-result!): Use type<=?
  instead of = for &exact-integer.
* module/language/cps/type-fold.scm (logtest, mul, logbit?): Use
  type<=?.
* module/language/cps/specialize-numbers.scm (inferred-sigbits):
  (specialize-operations): Use type<=?.
This commit is contained in:
Andy Wingo 2017-10-26 15:10:39 +02:00
parent 3d848f22f8
commit 2ca88789b1
3 changed files with 75 additions and 50 deletions
Download patch file Download diff file Expand all files Collapse all files

12
module/language/cps/specialize-numbers.scm
View file

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2015, 2016 Free Software Foundation, Inc.
;; Copyright (C) 2015, 2016, 2017 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@ -186,7 +186,7 @@
(define (inferred-sigbits types label var)
(call-with-values (lambda () (lookup-pre-type types label var))
(lambda (type min max)
(and (or (eqv? type &exact-integer) (eqv? type &u64))
(and (type<=? type (logior &exact-integer &u64 &s64))
(range->sigbits min max)))))
(define significant-bits-handlers (make-hash-table))
@ -284,7 +284,7 @@ BITS indicating the significant bits needed for a variable. BITS may be
(call-with-values (lambda ()
(lookup-pre-type types label var))
(lambda (type min max)
(and (eqv? type &type) (<= &min min max &max)))))
(and (type<=? type &type) (<= &min min max &max)))))
(define (u64-operand? var)
(operand-in-range? var &exact-integer 0 #xffffffffffffffff))
(define (all-u64-bits-set? var)
@ -300,7 +300,7 @@ BITS indicating the significant bits needed for a variable. BITS may be
(lambda ()
(lookup-post-type types label result 0))
(lambda (type min max)
(and (eqv? type &exact-integer)
(and (type<=? type &exact-integer)
(<= 0 min max #xffffffffffffffff))))))
(define (f64-operands? vara varb)
(let-values (((typea mina maxa) (lookup-pre-type types label vara))
@ -326,7 +326,7 @@ BITS indicating the significant bits needed for a variable. BITS may be
(with-cps cps
(let$ body (specialize-f64-binop k src op a b))
(setk label ($kargs names vars ,body))))
((and (eqv? type &exact-integer)
((and (type<=? type &exact-integer)
(or (<= 0 min max #xffffffffffffffff)
(only-u64-bits-used? result))
(u64-operand? a) (u64-operand? b)
@ -349,7 +349,7 @@ BITS indicating the significant bits needed for a variable. BITS may be
(cond
((or (not (u64-result? result))
(not (u64-operand? a))
(not (eqv? b-type &exact-integer))
(not (type<=? b-type &exact-integer))
(< b-min 0 b-max)
(<= b-min -64)
(<= 64 b-max))

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

@ -1,5 +1,5 @@
;;; Abstract constant folding on CPS
;;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
;;; Copyright (C) 2014, 2015, 2017 Free Software Foundation, Inc.
;;;
;;; This library is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as
@ -41,7 +41,7 @@
;; Branch folders.
(define &scalar-types
(logior &exact-integer &flonum &char &unspecified &false &true &nil &null))
(logior &fixnum &bignum &flonum &char &unspecified &false &true &nil &null))
(define *branch-folders* (make-hash-table))
@ -157,7 +157,8 @@
(if (< a b 0)
0
(max a b)))
(if (and (= min0 max0) (= min1 max1) (eqv? type0 type1 &exact-integer))
(if (and (= min0 max0) (= min1 max1)
(type<=? (logior type0 type1) &exact-integer))
(values #t (logtest min0 min1))
(values #f #f)))
@ -212,16 +213,16 @@
(build-term ($continue k src ($primcall 'ash (arg bits)))))))))
(define (mul/constant constant constant-type arg arg-type)
(cond
((not (or (= constant-type &exact-integer) (= constant-type arg-type)))
((not (or (type<=? constant-type &exact-integer)
(= constant-type arg-type)))
(fail))
((eqv? constant -1)
;; (* arg -1) -> (- 0 arg)
(negate arg))
((eqv? constant 0)
;; (* arg 0) -> 0 if arg is not a flonum or complex
(and (= constant-type &exact-integer)
(zero? (logand arg-type
(lognot (logior &flonum &complex))))
;; (* arg 0) -> 0 if arg is exact
(and (type<=? constant-type &exact-integer)
(type<=? arg-type (logior &exact-integer &fraction))
(zero)))
((eqv? constant 1)
;; (* arg 1) -> arg
@ -229,7 +230,7 @@
((eqv? constant 2)
;; (* arg 2) -> (+ arg arg)
(double arg))
((and (= constant-type arg-type &exact-integer)
((and (type<=? (logior constant-type arg-type) &exact-integer)
(positive? constant)
(zero? (logand constant (1- constant))))
;; (* arg power-of-2) -> (ash arg (log2 power-of-2
@ -268,7 +269,7 @@
;; Hairiness because we are converting from a primcall with unknown
;; arity to a branching primcall.
(let ((positive-fixnum-bits (- (* (target-word-size) 8) 3)))
(if (and (= type0 &exact-integer)
(if (and (type<=? type0 &exact-integer)
(<= 0 min0 positive-fixnum-bits)
(<= 0 max0 positive-fixnum-bits))
(match (intmap-ref cps k)
@ -304,7 +305,8 @@
(define (local-type-fold start end cps)
(define (scalar-value type val)
(cond
((eqv? type &exact-integer) val)
((eqv? type &fixnum) val)
((eqv? type &bignum) val)
((eqv? type &flonum) (exact->inexact val))
((eqv? type &char) (integer->char val))
((eqv? type &unspecified) *unspecified*)

89
module/language/cps/types.scm
View file

@ -1,5 +1,5 @@
;;; Type analysis on CPS
;;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
;;; Copyright (C) 2014, 2015, 2017 Free Software Foundation, Inc.
;;;
;;; This library is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as
@ -86,7 +86,8 @@
#:use-module (srfi srfi-11)
#:use-module ((system syntax internal) #:select (syntax?))
#:export (;; Specific types.
&exact-integer
&fixnum
&bignum
&flonum
&complex
&fraction
@ -116,13 +117,17 @@
&syntax
;; Union types.
&number &real
&exact-integer &number &real
;; Untagged types.
&f64
&u64
&s64
;; Helper.
type<=?
;; Interface for type inference.
infer-types
lookup-pre-type
lookup-post-type
@ -143,7 +148,8 @@
;; More precise types have fewer bits.
(define-flags &all-types &type-bits
&exact-integer
&fixnum
&bignum
&flonum
&complex
&fraction
@ -178,10 +184,15 @@
(define-syntax &no-type (identifier-syntax 0))
(define-syntax &exact-integer
(identifier-syntax (logior &fixnum &bignum)))
(define-syntax &number
(identifier-syntax (logior &exact-integer &flonum &complex &fraction)))
(identifier-syntax (logior &fixnum &bignum &flonum &complex &fraction)))
(define-syntax &real
(identifier-syntax (logior &exact-integer &flonum &fraction)))
(identifier-syntax (logior &fixnum &bignum &flonum &fraction)))
(define-syntax-rule (type<=? x type)
(zero? (logand x (lognot type))))
;; Versions of min and max that do not coerce exact numbers to become
;; inexact.
@ -326,7 +337,11 @@ minimum, and maximum."
(cond
((number? val)
(cond
((exact-integer? val) (return &exact-integer val))
((exact-integer? val)
(return (if (<= most-negative-fixnum val most-positive-fixnum)
&fixnum
&bignum)
val))
((eqv? (imag-part val) 0)
(if (nan? val)
(make-type-entry &flonum -inf.0 +inf.0)
@ -369,6 +384,14 @@ minimum, and maximum."
(define-type-helper &min)
(define-type-helper &max)
(define-syntax-rule (define-exact-integer! result min max)
(let ((min* min) (max* max))
(define! result
(if (<= most-negative-fixnum min* max* most-positive-fixnum)
&fixnum
&exact-integer)
min* max*)))
;; Accessors to use in type inferrers where you know that the values
;; must be in some range for the computation to proceed (not throw an
;; error). Note that these accessors should be used even for &u64 and
@ -761,7 +784,7 @@ minimum, and maximum."
(define-type-checker (u64->scm u64)
#t)
(define-type-inferrer (u64->scm u64 result)
(define! result &exact-integer (&min/0 u64) (&max/u64 u64)))
(define-exact-integer! result (&min/0 u64) (&max/u64 u64)))
(define-type-checker (scm->s64 scm)
(check-type scm &exact-integer &s64-min &s64-max))
@ -773,7 +796,7 @@ minimum, and maximum."
(define-type-checker (s64->scm s64)
#t)
(define-type-inferrer (s64->scm s64 result)
(define! result &exact-integer (&min/s64 s64) (&max/s64 s64)))
(define-exact-integer! result (&min/s64 s64) (&max/s64 s64)))
@ -851,7 +874,7 @@ minimum, and maximum."
(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)
(if (type<=? (logior type0 type1) &exact-integer)
(infer-integer-ranges)
(infer-real-ranges)))
@ -982,8 +1005,8 @@ minimum, and maximum."
(logior &complex &flonum))))
(define! result result-type min* max*)))
;; Exact integers are closed under some operations.
((and closed? (eqv? a-type &exact-integer) (eqv? b-type &exact-integer))
(define! result &exact-integer min* max*))
((and closed? (type<=? (logior a-type b-type) &exact-integer))
(define-exact-integer! result min* max*))
(else
(let* ((type (logior a-type b-type))
;; Fractions may become integers.
@ -1150,11 +1173,11 @@ minimum, and maximum."
(let ((max-abs-rem (1- (max (abs (&min b)) (abs (&max b))))))
(cond
((< (&min a) 0)
(if (< 0 (&max a))
(define! result &exact-integer (- max-abs-rem) max-abs-rem)
(define! result &exact-integer (- max-abs-rem) 0)))
(define-exact-integer! result
(- max-abs-rem)
(if (< 0 (&max a)) max-abs-rem 0)))
(else
(define! result &exact-integer 0 max-abs-rem)))))
(define-exact-integer! result 0 max-abs-rem)))))
(define-type-checker-aliases quo mod)
(define-type-inferrer (mod a b result)
@ -1164,11 +1187,11 @@ minimum, and maximum."
(let ((max-abs-mod (1- (max (abs (&min b)) (abs (&max b))))))
(cond
((< (&min b) 0)
(if (< 0 (&max b))
(define! result &exact-integer (- max-abs-mod) max-abs-mod)
(define! result &exact-integer (- max-abs-mod) 0)))
(define-exact-integer! result
(- max-abs-mod)
(if (< 0 (&max b)) max-abs-mod 0)))
(else
(define! result &exact-integer 0 max-abs-mod)))))
(define-exact-integer! result 0 max-abs-mod)))))
;; Predicates.
(define-syntax-rule (define-number-kind-predicate-inferrer name type)
@ -1246,9 +1269,9 @@ minimum, and maximum."
(-+ (ash* (&min val) (&max count)))
(++ (ash* (&max val) (&max count)))
(+- (ash* (&max val) (&min count))))
(define! result &exact-integer
(min -- -+ ++ +-)
(max -- -+ ++ +-))))
(define-exact-integer! result
(min -- -+ ++ +-)
(max -- -+ ++ +-))))
(define-simple-type-checker (ursh &u64 &u64))
(define-type-inferrer (ursh a b result)
@ -1291,9 +1314,9 @@ minimum, and maximum."
0))
(restrict! a &exact-integer -inf.0 +inf.0)
(restrict! b &exact-integer -inf.0 +inf.0)
(define! result &exact-integer
(logand-min (&min a) (&min b))
(logand-max (&max a) (&max b))))
(define-exact-integer! result
(logand-min (&min a) (&min b))
(logand-max (&max a) (&max b))))
(define-simple-type-checker (ulogand &u64 &u64))
(define-type-inferrer (ulogand a b result)
@ -1324,7 +1347,7 @@ minimum, and maximum."
(call-with-values (lambda ()
(logsub-bounds (&min a) (&max a) (&min b) (&max b)))
(lambda (min max)
(define! result &exact-integer min max))))
(define-exact-integer! result min max))))
(define-simple-type-checker (ulogsub &u64 &u64))
(define-type-inferrer (ulogsub a b result)
@ -1349,9 +1372,9 @@ minimum, and maximum."
(else (saturate (logior a b)))))
(restrict! a &exact-integer -inf.0 +inf.0)
(restrict! b &exact-integer -inf.0 +inf.0)
(define! result &exact-integer
(logior-min (&min a) (&min b))
(logior-max (&max a) (&max b))))
(define-exact-integer! result
(logior-min (&min a) (&min b))
(logior-max (&max a) (&max b))))
(define-simple-type-checker (ulogior &u64 &u64))
(define-type-inferrer (ulogior a b result)
@ -1373,9 +1396,9 @@ minimum, and maximum."
(define-simple-type-checker (lognot &exact-integer))
(define-type-inferrer (lognot a result)
(restrict! a &exact-integer -inf.0 +inf.0)
(define! result &exact-integer
(- -1 (&max a))
(- -1 (&min a))))
(define-exact-integer! result
(- -1 (&max a))
(- -1 (&min a))))
(define-simple-type-checker (logtest &exact-integer &exact-integer))
(define-predicate-inferrer (logtest a b true?)