Add an Exact-Number type.

collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt

@@ -871,7 +871,7 @@
    (tc-l -5# -NegFlonum)
    (tc-l -5.0 -NegFlonum)
    (tc-l -5.1 -NegFlonum)
-   (tc-l 1+1i N)
+   (tc-l 1+1i -ExactNumber)
    (tc-l 1+1.0i -FloatComplex)
    (tc-l 1.0+1i -FloatComplex)
    (tc-l 1.0+1.1i -FloatComplex)

collects/typed-scheme/private/base-types.rkt

@@ -5,6 +5,7 @@
 [Inexact-Complex -InexactComplex]
 [Single-Flonum-Complex -SingleFlonumComplex]
 [Float-Complex -FloatComplex]
+[Exact-Number -ExactNumber]
 [Real -Real]
 [Nonpositive-Real -NonPosReal]
 [Negative-Real -NegReal]

collects/typed-scheme/private/type-contract.rkt

@@ -164,6 +164,7 @@
         [(== t:-NegReal type-equal?) #'(flat-named-contract 'Negative-Real (and/c real? negative?))]
         [(== t:-NonPosReal type-equal?) #'(flat-named-contract 'Nonpositive-Real (and/c real? (lambda (x) (<= x 0))))]
         [(== t:-Real type-equal?) #'(flat-named-contract 'Real real?)]
+        [(== t:-ExactNumber type-equal?) #'(flat-named-contract 'Exact-Number (and/c number? exact?))]
         [(== t:-InexactComplex type-equal?)
          #'(flat-named-contract 'Inexact-Complex
                                 (and/c number?

collects/typed-scheme/typecheck/tc-expr-unit.rkt

@@ -59,6 +59,8 @@
     [(~var i (3d inexact-real?)) -InexactReal] ; catch-all, just in case
     [(~var i (3d real?)) -Real] ; catch-all, just in case
     ;; a complex number can't have a float imaginary part and an exact real part
+    [(~var i (3d (conjoin number? exact?)))
+     -ExactNumber]
     [(~var i (3d (conjoin number? (lambda (x) (and (flonum? (imag-part x))
                                                    (flonum? (real-part x)))))))
      -FloatComplex]

collects/typed-scheme/types/convenience.rkt

@@ -38,6 +38,7 @@
         [(? (lambda (t) (subtype t -SingleFlonum))) -SingleFlonum]
         [(? (lambda (t) (subtype t -InexactReal))) -InexactReal]
         [(? (lambda (t) (subtype t -Real))) -Real]
+        [(? (lambda (t) (subtype t -ExactNumber))) -ExactNumber]
         [(? (lambda (t) (subtype t -FloatComplex))) -FloatComplex]
         [(? (lambda (t) (subtype t -SingleFlonumComplex))) -SingleFlonumComplex]
         [(? (lambda (t) (subtype t -Number))) -Number]

collects/typed-scheme/types/numeric-tower.rkt

@@ -16,7 +16,7 @@
          -SingleFlonumPosZero -SingleFlonumNegZero -SingleFlonumZero -PosSingleFlonum -NonNegSingleFlonum -NegSingleFlonum -NonPosSingleFlonum -SingleFlonum
          -InexactRealPosZero -InexactRealNegZero -InexactRealZero -PosInexactReal -NonNegInexactReal -NegInexactReal -NonPosInexactReal -InexactReal
          -RealZero -PosReal -NonNegReal -NegReal -NonPosReal -Real
-         -FloatComplex -SingleFlonumComplex -InexactComplex -Number
+         -ExactNumber -FloatComplex -SingleFlonumComplex -InexactComplex -Number
          (rename-out (-Int -Integer)))
 
 
@@ -204,6 +204,16 @@
 ;; Both parts of a complex number must be of the same exactness.
 ;; Thus, the only possible kinds of complex numbers are:
 ;; Real/Real, Flonum/Flonum, SingleFlonum/SingleFlonum
+(define -ExactNumberNotReal
+  (make-Base 'Complex-Not-Real
+             #'(and/c number?
+                      (not/c real?)
+                      (lambda (x) (exact? (imag-part x))))
+             (conjoin number?
+                      (negate real?)
+                      (lambda (x) (exact? (imag-part x))))
+             #'-ExactNumberNotReal))
+(define -ExactNumber (*Un -ExactNumberNotReal -Rat))
 (define -FloatComplex (make-Base 'Float-Complex
                                  #'(and/c number?
                                           (lambda (x)
@@ -225,14 +235,5 @@
                                                       (single-flonum? (real-part x)))))
                                       #'-SingleFlonumComplex))
 (define -InexactComplex (*Un -FloatComplex -SingleFlonumComplex))
-(define -ExactComplexNotReal
+(define -Complex (*Un -Real -InexactComplex -ExactNumberNotReal))
-  (make-Base 'Complex-Not-Real
-             #'(and/c number?
-                      (not/c real?)
-                      (lambda (x) (exact? (imag-part x))))
-             (conjoin number?
-                      (negate real?)
-                      (lambda (x) (exact? (imag-part x))))
-             #'-ExactComplexNotReal))
-(define -Complex (*Un -Real -InexactComplex -ExactComplexNotReal))
 (define -Number -Complex)