diff --git a/collects/tests/typed-scheme/fail/inexact-complex.rkt b/collects/tests/typed-scheme/fail/inexact-complex.rkt new file mode 100644 index 00000000..1619911c --- /dev/null +++ b/collects/tests/typed-scheme/fail/inexact-complex.rkt @@ -0,0 +1,9 @@ +#; +(exn-pred 2) +#lang typed/scheme + +(ann 1+2i Inexact-Complex) + +(: f (Real -> Inexact-Complex)) +(define (f x) + (* x 2.0)) ; x can be exact 0 diff --git a/collects/tests/typed-scheme/succeed/inexact-complex.rkt b/collects/tests/typed-scheme/succeed/inexact-complex.rkt new file mode 100644 index 00000000..04e1c1b5 --- /dev/null +++ b/collects/tests/typed-scheme/succeed/inexact-complex.rkt @@ -0,0 +1,9 @@ +#lang typed/scheme + +(ann 1.1+2.0i Inexact-Complex) +(ann 1+2.0i Inexact-Complex) +(ann (real-part 1.1+2.0i) Float) +(ann (real-part 1+2.0i) Float) +(ann (imag-part 1.1+2.0i) Float) +(ann (+ 2.0 2.0+2.0i) Inexact-Complex) +(ann (+ 2 2.0+2.0i) Inexact-Complex) diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt index 62314b0a..46c300ab 100644 --- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt +++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt @@ -842,6 +842,10 @@ (tc-l 5# -Flonum) (tc-l 5.0 -Flonum) (tc-l 5.1 -Flonum) + (tc-l 1+1i N) + (tc-l 1+1.0i -InexactComplex) + (tc-l 1.0+1i -InexactComplex) + (tc-l 1.0+1.1i -InexactComplex) (tc-l #t (-val #t)) (tc-l "foo" -String) (tc-l foo (-val 'foo)) diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt index ac078375..75d8e56c 100644 --- a/collects/typed-scheme/private/base-env-numeric.rkt +++ b/collects/typed-scheme/private/base-env-numeric.rkt @@ -61,7 +61,7 @@ [complex? (make-pred-ty N)] [rational? (make-pred-ty -Real)] [exact? (asym-pred N B (-FS -top (-not-filter -ExactRational 0)))] -[inexact? (asym-pred N B (-FS -top (-not-filter -Flonum 0)))] +[inexact? (asym-pred N B (-FS -top (-not-filter (Un -Flonum -InexactComplex) 0)))] [fixnum? (make-pred-ty -Fixnum)] [positive? (-> -Real B)] [negative? (-> -Real B)] @@ -94,6 +94,7 @@ [* (apply cl->* (append (for/list ([t (list -Pos -Nat -Integer -ExactRational -Flonum)]) (->* (list) t t)) (list (->* (list) -Real -Real)) + (list (->* (list) -InexactComplex -InexactComplex)) (list (->* (list) N N))))] [+ (apply cl->* (append (for/list ([t (list -Pos -Nat -Integer -ExactRational -Flonum)]) (->* (list) t t)) @@ -102,6 +103,9 @@ (list (->* (list -Flonum) -Real -Flonum)) (list (->* (list -Real -Flonum) -Real -Flonum)) (list (->* (list) -Real -Real)) + (list (->* (list -Real) -InexactComplex -InexactComplex)) + (list (->* (list -InexactComplex) -Real -InexactComplex)) + (list (->* (list) -InexactComplex -InexactComplex)) (list (->* (list) N N))))] [- (apply cl->* @@ -110,6 +114,9 @@ (list (->* (list -Flonum) -Real -Flonum)) (list (->* (list -Real -Flonum) -Real -Flonum)) (list (->* (list -Real) -Real -Real)) + (list (->* (list -Real) -InexactComplex -InexactComplex)) + (list (->* (list -InexactComplex) -Real -InexactComplex)) + (list (->* (list -InexactComplex) -InexactComplex -InexactComplex)) (list (->* (list N) N N))))] [/ (apply cl->* (append (list (->* (list -Integer) -Integer -ExactRational)) @@ -118,6 +125,7 @@ ;; only exact 0 as first argument can cause the result of a division involving inexacts to be exact (list (->* (list -Flonum) -Real -Flonum)) (list (->* (list -Real) -Real -Real)) + (list (->* (list -InexactComplex) -InexactComplex -InexactComplex)) (list (->* (list N) N N))))] [max (cl->* (->* (list -PositiveFixnum) -Fixnum -PositiveFixnum) @@ -149,6 +157,7 @@ (-> -ExactRational -ExactRational) (-> -Flonum -Flonum) (-> -Real -Real) + (-> -InexactComplex -InexactComplex) (-> N N))] [sub1 (cl->* (-> -Pos -Nat) @@ -156,6 +165,7 @@ (-> -ExactRational -ExactRational) (-> -Flonum -Flonum) (-> -Real -Real) + (-> -InexactComplex -InexactComplex) (-> N N))] [quotient (cl->* (-NonnegativeFixnum -NonnegativeFixnum . -> . -NonnegativeFixnum) @@ -199,7 +209,7 @@ ;; exactness [exact->inexact (cl->* (-Real . -> . -Flonum) - (N . -> . N))] + (N . -> . -InexactComplex))] [inexact->exact (cl->* (-Real . -> . -ExactRational) (N . -> . N))] @@ -208,33 +218,47 @@ [ceiling rounder] [truncate rounder] [round rounder] -[make-rectangular (-Real -Real . -> . N)] -[make-polar (-Real -Real . -> . N)] -[real-part (N . -> . -Real)] -[imag-part (N . -> . -Real)] -[magnitude (N . -> . -Real)] -[angle (N . -> . -Real)] -[numerator (-Real . -> . -Real)] -[denominator (-Real . -> . -Real)] -[rationalize (-Real -Real . -> . N)] +[make-rectangular (cl->* (-Flonum -Flonum . -> . -InexactComplex) + (-Real -Real . -> . N))] +[make-polar (cl->* (-Flonum -Flonum . -> . -InexactComplex) + (-Real -Real . -> . N))] +[real-part (cl->* (-InexactComplex . -> . -Flonum) + (N . -> . -Real))] +[imag-part (cl->* (-InexactComplex . -> . -Flonum) + (N . -> . -Real))] +[magnitude (cl->* (-InexactComplex . -> . -Flonum) + (N . -> . -Real))] +[angle (cl->* (-InexactComplex . -> . -Flonum) + (N . -> . -Real))] +[numerator (cl->* (-ExactRational . -> . -Integer) + (-Real . -> . -Real))] +[denominator (cl->* (-ExactRational . -> . -Integer) + (-Real . -> . -Real))] +[rationalize (cl->* (-ExactRational -ExactRational . -> . -ExactRational) + (-Flonum . -> . -Flonum) + (-Real -Real . -> . N))] [expt (cl->* (-Nat -Nat . -> . -Nat) (-Integer -Nat . -> . -Integer) (-Real -Integer . -> . -Real) + (-InexactComplex -InexactComplex . -> . -InexactComplex) (N N . -> . N))] [sqrt (cl->* (-Nat . -> . -Real) + (-InexactComplex . -> . -InexactComplex) (N . -> . N))] [log (cl->* (-Pos . -> . -Real) + (-InexactComplex . -> . -InexactComplex) (N . -> . N))] [exp (cl->* (-Real . -> . -Real) + (-InexactComplex . -> . -InexactComplex) (N . -> . N))] -[cos (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (N . -> . N))] -[sin (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (N . -> . N))] -[tan (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (N . -> . N))] -[acos (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (N . -> . N))] -[asin (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (N . -> . N))] -[atan (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (N . -> . N) (-Real -Real . -> . N))] +[cos (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))] +[sin (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))] +[tan (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))] +[acos (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))] +[asin (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))] +[atan (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N) (-Real -Real . -> . N))] [gcd (cl->* (null -Fixnum . ->* . -Fixnum) (null -Integer . ->* . -Integer))] [lcm (null -Integer . ->* . -Integer)] @@ -248,12 +272,16 @@ (-> -ExactRational -ExactRational) (-> -Flonum -Flonum) (-> -Real -Real) + (-> -InexactComplex -InexactComplex) (-> N N))] -[sgn (N . -> . N)] -[conjugate (N . -> . N)] -[sinh (N . -> . N)] -[cosh (N . -> . N)] -[tanh (N . -> . N)] +[conjugate (cl->* (-InexactComplex . -> . -InexactComplex) + (N . -> . N))] +[sinh (cl->* (-InexactComplex . -> . -InexactComplex) + (N . -> . N))] +[cosh (cl->* (-InexactComplex . -> . -InexactComplex) + (N . -> . N))] +[tanh (cl->* (-InexactComplex . -> . -InexactComplex) + (N . -> . N))] ;; unsafe numeric ops [unsafe-flabs fl-unop] diff --git a/collects/typed-scheme/private/base-types.rkt b/collects/typed-scheme/private/base-types.rkt index a406ea74..9f8f775c 100644 --- a/collects/typed-scheme/private/base-types.rkt +++ b/collects/typed-scheme/private/base-types.rkt @@ -1,6 +1,7 @@ #lang s-exp "type-env-lang.rkt" [Complex -Number] +[Inexact-Complex -InexactComplex] [Number -Number] [Integer -Integer] [Real -Real] diff --git a/collects/typed-scheme/scribblings/ts-reference.scrbl b/collects/typed-scheme/scribblings/ts-reference.scrbl index c831a506..e96d08ef 100644 --- a/collects/typed-scheme/scribblings/ts-reference.scrbl +++ b/collects/typed-scheme/scribblings/ts-reference.scrbl @@ -34,6 +34,7 @@ any expression of this type will not evaluate to a value.} @deftogether[( @defidform[Number] @defidform[Complex] +@defidform[Inexact-Complex] @defidform[Real] @defidform[Float] @defidform[Exact-Rational] diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.rkt b/collects/typed-scheme/typecheck/tc-expr-unit.rkt index b1beaeb4..2a213987 100644 --- a/collects/typed-scheme/typecheck/tc-expr-unit.rkt +++ b/collects/typed-scheme/typecheck/tc-expr-unit.rkt @@ -43,6 +43,9 @@ [(~var i (3d (conjoin number? exact? rational?))) -ExactRational] [(~var i (3d inexact-real?)) -Flonum] [(~var i (3d real?)) -Real] + ;; a complex number can't have an inexact imaginary part and an exact real part + [(~var i (3d (conjoin number? (lambda (x) (inexact-real? (imag-part x)))))) + -InexactComplex] [(~var i (3d number?)) -Number] [i:str -String] [i:char -Char] diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt index f4a5b562..bf40ffd2 100644 --- a/collects/typed-scheme/types/abbrev.rkt +++ b/collects/typed-scheme/types/abbrev.rkt @@ -150,6 +150,9 @@ ;; Numeric hierarchy (define -Number (make-Base 'Number #'number?)) +;; a complex number can't have an inexact imaginary part and an exact real part +(define -InexactComplex (make-Base 'InexactComplex #'(and/c number? (lambda (x) (inexact-real? (imag-part x)))))) + (define -Flonum (make-Base 'Flonum #'inexact-real?)) (define -ExactRational diff --git a/collects/typed-scheme/types/subtype.rkt b/collects/typed-scheme/types/subtype.rkt index aee51187..8b9047c3 100644 --- a/collects/typed-scheme/types/subtype.rkt +++ b/collects/typed-scheme/types/subtype.rkt @@ -233,10 +233,11 @@ [((Union: (list)) _) A0] ;; value types [((Value: v1) (Value: v2)) (=> unmatch) (if (equal? v1 v2) A0 (unmatch))] - ;; now we encode the numeric hierarchy - bletch + ;; now we encode the numeric hierarchy - bletch [((Base: 'Integer _) (Base: 'Number _)) A0] [((Base: 'Flonum _) (== -Real =t)) A0] [((Base: 'Integer _) (== -Real =t)) A0] + [((Base: 'Flonum _) (Base: 'InexactComplex _)) A0] [((Base: 'Flonum _) (Base: 'Number _)) A0] [((Base: 'Exact-Rational _) (Base: 'Number _)) A0] [((Base: 'Integer _) (Base: 'Exact-Rational _)) A0] @@ -263,6 +264,8 @@ [((== -Fixnum =t) (Base: 'Exact-Rational _)) A0] [((== -Fixnum =t) (Base: 'Integer _)) A0] + [((Base: 'InexactComplex _) (Base: 'Number _)) A0] + ;; values are subtypes of their "type" [((Value: (? exact-integer? n)) (Base: 'Integer _)) A0]