[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 06/07: Type inference distinguishes &fixnum and &bignum
From: |
Andy Wingo |
Subject: |
[Guile-commits] 06/07: Type inference distinguishes &fixnum and &bignum types |
Date: |
Thu, 26 Oct 2017 10:07:17 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit 2ca88789b11c0314550eb828118bbdc1c24fc07e
Author: Andy Wingo <address@hidden>
Date: Thu Oct 26 15:10:39 2017 +0200
Type inference distinguishes &fixnum and &bignum types
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<=?.
---
module/language/cps/specialize-numbers.scm | 12 ++--
module/language/cps/type-fold.scm | 24 ++++----
module/language/cps/types.scm | 89 +++++++++++++++++++-----------
3 files changed, 75 insertions(+), 50 deletions(-)
diff --git a/module/language/cps/specialize-numbers.scm
b/module/language/cps/specialize-numbers.scm
index d558703..7c86bcf 100644
--- a/module/language/cps/specialize-numbers.scm
+++ b/module/language/cps/specialize-numbers.scm
@@ -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))
diff --git a/module/language/cps/type-fold.scm
b/module/language/cps/type-fold.scm
index fc37fac..b59253e 100644
--- a/module/language/cps/type-fold.scm
+++ b/module/language/cps/type-fold.scm
@@ -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*)
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 8464a65..b71bd39 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -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?)
- [Guile-commits] branch master updated (214e887 -> cd947a1), Andy Wingo, 2017/10/26
- [Guile-commits] 04/07: Add assembler and disassembler support for new instructions, Andy Wingo, 2017/10/26
- [Guile-commits] 03/07: Add (system base types internal)., Andy Wingo, 2017/10/26
- [Guile-commits] 01/07: Add support for C16_C16 instruction words, Andy Wingo, 2017/10/26
- [Guile-commits] 02/07: Add new-style test and branch instructions, Andy Wingo, 2017/10/26
- [Guile-commits] 07/07: Model all special immediates under one type bit (with range), Andy Wingo, 2017/10/26
- [Guile-commits] 05/07: First step towards emitting new instructions: "j" instead of "br", Andy Wingo, 2017/10/26
- [Guile-commits] 06/07: Type inference distinguishes &fixnum and &bignum types,
Andy Wingo <=