diff --git a/typed-racket-lib/typed-racket/base-env/base-env-numeric.rkt b/typed-racket-lib/typed-racket/base-env/base-env-numeric.rkt index 4c1db9db..3e193c25 100644 --- a/typed-racket-lib/typed-racket/base-env/base-env-numeric.rkt +++ b/typed-racket-lib/typed-racket/base-env/base-env-numeric.rkt @@ -955,14 +955,14 @@ [* (from-cases (-> -One) + (-> N N : -true-filter : (-arg-path 0)) (commutative-case -Zero N -Zero) - (map (lambda (t) (commutative-binop -One t)) - all-number-types) + (-> N -One N : -true-filter : (-arg-path 0)) + (-> -One N N : -true-filter : (-arg-path 1)) (-> -PosByte -PosByte -PosIndex) (-> -Byte -Byte -Index) (-> -PosByte -PosByte -PosByte -PosFixnum) (-> -Byte -Byte -Byte -NonNegFixnum) - (map unop all-int-types) (varop -PosInt) (varop -Nat) (-> -NegInt -NegInt) @@ -982,7 +982,6 @@ (commutative-binop -NonPosRat -NonNegRat -NonPosRat) (-> -NegRat -NegRat -NegRat -NegRat) (-> -NonPosRat -NonPosRat -NonPosRat -NonPosRat) - (map unop rat-types) (varop -Rat) (varop-1+ -FlonumZero) ; no pos * -> pos, possible underflow @@ -994,23 +993,19 @@ ;; (* 0) is exact 0 (i.e. not a float) (commutative-case -NonNegFlonum -PosReal) ; real args don't include 0 (commutative-case -Flonum (Un -PosReal -NegReal) -Flonum) - (map unop all-flonum-types) (map varop-1+ (list -Flonum -SingleFlonumZero -NonNegSingleFlonum)) ;; we could add contagion rules for negatives, but we haven't for now (-> -NegSingleFlonum -NegSingleFlonum -NonNegSingleFlonum) ; possible underflow, so no neg neg -> pos (-> -NegSingleFlonum -NegSingleFlonum -NegSingleFlonum -NonPosSingleFlonum) (commutative-case -NonNegSingleFlonum (Un -PosRat -NonNegSingleFlonum)) (commutative-case -SingleFlonum (Un -PosRat -NegRat -SingleFlonum) -SingleFlonum) - (map unop single-flonum-types) (map varop-1+ (list -SingleFlonum -InexactRealZero -NonNegInexactReal)) (-> -NegInexactReal -NegInexactReal -NonNegInexactReal) (-> -NegInexactReal -NegInexactReal -NegInexactReal -NonPosInexactReal) (commutative-case -NonNegInexactReal (Un -PosRat -NonNegInexactReal)) (commutative-case -InexactReal (Un -PosRat -NegRat -InexactReal) -InexactReal) - (map unop inexact-real-types) (varop-1+ -InexactReal) ;; reals - (map unop real-types) (varop -NonNegReal) ; (* +inf.0 0.0) -> +nan.0 (-> -NonPosReal -NonPosReal -NonNegReal) (commutative-binop -NonPosReal -NonNegReal -NonPosReal) @@ -1020,14 +1015,13 @@ (commutative-case -FloatComplex (Un -InexactComplex -InexactReal -PosRat -NegRat) -FloatComplex) (commutative-case -SingleFlonumComplex (Un -SingleFlonumComplex -SingleFlonum -PosRat -NegRat) -SingleFlonumComplex) (commutative-case -InexactComplex (Un -InexactComplex -InexactReal -PosRat -NegRat) -InexactComplex) - (map unop number-types) (varop N))] [+ (from-cases (-> -Zero) + (-> N N : -true-filter : (-arg-path 0)) (binop -Zero) - (map (lambda (t) (commutative-binop t -Zero t)) - (list -One -PosByte -Byte -PosIndex -Index - -PosFixnum -NonNegFixnum -NegFixnum -NonPosFixnum -Fixnum)) + (-> N -Zero N : -true-filter : (-arg-path 0)) + (-> -Zero N N : -true-filter : (-arg-path 1)) (-> -PosByte -PosByte -PosIndex) (-> -Byte -Byte -Index) (-> -PosByte -PosByte -PosByte -PosIndex) @@ -1042,11 +1036,9 @@ (commutative-binop -NonPosFixnum -NonNegFixnum -Fixnum) (commutative-case -PosInt -Nat -PosInt) (commutative-case -NegInt -NonPosInt -NegInt) - (map unop all-int-types) (map varop (list -Nat -NonPosInt -Int)) (commutative-case -PosRat -NonNegRat -PosRat) (commutative-case -NegRat -NonPosRat -NegRat) - (map unop rat-types) (map varop (list -NonNegRat -NonPosRat -Rat)) ;; flonum + real -> flonum (commutative-case -PosFlonum -NonNegReal -PosFlonum) @@ -1056,7 +1048,6 @@ (commutative-case -NonNegFlonum -NonNegReal -NonNegFlonum) (commutative-case -NonPosFlonum -NonPosReal -NonPosFlonum) (commutative-case -Flonum -Real -Flonum) - (map unop all-flonum-types) (varop-1+ -Flonum) ;; single-flonum + rat -> single-flonum (commutative-case -PosSingleFlonum (Un -NonNegRat -NonNegSingleFlonum) -PosSingleFlonum) @@ -1066,7 +1057,6 @@ (commutative-case -NonNegSingleFlonum (Un -NonNegRat -NonNegSingleFlonum) -NonNegSingleFlonum) (commutative-case -NonPosSingleFlonum (Un -NonPosRat -NonPosSingleFlonum) -NonPosSingleFlonum) (commutative-case -SingleFlonum (Un -Rat -SingleFlonum) -SingleFlonum) - (map unop single-flonum-types) (varop-1+ -SingleFlonum) ;; inexact-real + real -> inexact-real (commutative-case -PosInexactReal -NonNegReal -PosInexactReal) @@ -1076,18 +1066,15 @@ (commutative-case -NonNegInexactReal -NonNegReal -NonNegInexactReal) (commutative-case -NonPosInexactReal -NonPosReal -NonPosInexactReal) (commutative-case -InexactReal -Real -InexactReal) - (map unop inexact-real-types) ;; real (commutative-case -PosReal -NonNegReal -PosReal) (commutative-case -NegReal -NonPosReal -NegReal) - (map unop real-types) (map varop (list -NonNegReal -NonPosReal -Real -ExactNumber)) ;; complex (commutative-case -FloatComplex N -FloatComplex) (commutative-case -Flonum -InexactComplex -FloatComplex) (commutative-case -SingleFlonumComplex (Un -Rat -SingleFlonum -SingleFlonumComplex) -SingleFlonumComplex) (commutative-case -InexactComplex (Un -Rat -InexactReal -InexactComplex) -InexactComplex) - (map unop number-types) (varop N))] [- (from-cases @@ -1099,9 +1086,8 @@ (negation-pattern -PosSingleFlonum -NegSingleFlonum -NonNegSingleFlonum -NonPosSingleFlonum) (negation-pattern -PosInexactReal -NegInexactReal -NonNegInexactReal -NonPosInexactReal) (negation-pattern -PosReal -NegReal -NonNegReal -NonPosReal) - (map (lambda (t) (-> t -Zero t)) - (list -One -PosByte -Byte -PosIndex -Index - -PosFixnum -NonNegFixnum -NegFixnum -NonPosFixnum -Fixnum)) + + (-> N -Zero N : -true-filter : (-arg-path 0)) (-> -One -One -Zero) (-> -PosByte -One -Byte) (-> -PosIndex -One -Index) @@ -1138,8 +1124,7 @@ [/ (from-cases ; very similar to multiplication, without closure properties for integers (commutative-case -Zero N -Zero) (unop -One) - (map (lambda (t) (-> t -One t)) - all-number-types) + (-> N -One N : -true-filter : (-arg-path 0)) (varop-1+ -PosRat) (varop-1+ -NonNegRat) (-> -NegRat -NegRat) diff --git a/typed-racket-test/unit-tests/interactive-tests.rkt b/typed-racket-test/unit-tests/interactive-tests.rkt index 1099a088..16c77c7e 100644 --- a/typed-racket-test/unit-tests/interactive-tests.rkt +++ b/typed-racket-test/unit-tests/interactive-tests.rkt @@ -166,7 +166,7 @@ (test-form-exn #rx"at least one argument" (:query-type/args)) - (test-form (regexp-quote "(case-> (-> One One) (-> One))") + (test-form (regexp-quote "(-> One)") (:query-type/result * 1)) (test-form #rx"not in the given function's range.\n" (:query-type/result + String)) diff --git a/typed-racket-test/unit-tests/typecheck-tests.rkt b/typed-racket-test/unit-tests/typecheck-tests.rkt index 31b30005..98312629 100644 --- a/typed-racket-test/unit-tests/typecheck-tests.rkt +++ b/typed-racket-test/unit-tests/typecheck-tests.rkt @@ -1036,12 +1036,12 @@ |# ;; inference with internal define - [tc-e (let () - (define x 1) - (define y 2) - (define z (+ x y)) - (* x z)) - -PosIndex] + [tc-e/t (let () + (define x 1) + (define y 2) + (define z (+ x y)) + (* x z)) + -PosIndex] [tc-e/t (let () (define: (f [x : Number]) : Number