From 28890f267f6e790f4d7a4af57bb2294eb4c14aa3 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Fri, 20 Nov 2009 15:20:23 +0000 Subject: [PATCH] Skip backup files in tests. More specific numeric types. More subtyping relationships. svn: r16922 original commit: 6497745560505fc1366188909543031b2925e0bb --- collects/tests/typed-scheme/main.ss | 4 +- .../typed-scheme/private/base-env-numeric.ss | 64 +++++++++---------- collects/typed-scheme/types/subtype.ss | 14 ++-- 3 files changed, 43 insertions(+), 39 deletions(-) diff --git a/collects/tests/typed-scheme/main.ss b/collects/tests/typed-scheme/main.ss index 2b223600..74d68762 100644 --- a/collects/tests/typed-scheme/main.ss +++ b/collects/tests/typed-scheme/main.ss @@ -46,7 +46,9 @@ (define path (build-path (this-expression-source-directory) dir)) (define tests (for/list ([p (directory-list path)] - #:when (scheme-file? p)) + #:when (scheme-file? p) + ;; skip backup files + #:when (not (regexp-match #rx".*~" (path->string p)))) (test-case (path->string p) (test diff --git a/collects/typed-scheme/private/base-env-numeric.ss b/collects/typed-scheme/private/base-env-numeric.ss index 1f96254c..55eb34f7 100644 --- a/collects/typed-scheme/private/base-env-numeric.ss +++ b/collects/typed-scheme/private/base-env-numeric.ss @@ -20,35 +20,25 @@ [< (->* (list R R) R B)] [<= (->* (list R R) R B)] [> (->* (list R R) R B)] -[zero? (N . -> . B)] -[* (cl->* (->* '() -ExactPositiveInteger -ExactPositiveInteger) - (->* '() -Nat -Nat) - (->* '() -Integer -Integer) - (->* '() -ExactRational -ExactRational) - (->* '() -Flonum -Flonum) - (->* '() -Real -Real) - (->* '() N N))] -[/ (cl->* (->* (list -Integer) -Integer -ExactRational) - (->* (list -ExactRational) -ExactRational -ExactRational) - (->* (list -Flonum) -Flonum -Flonum) - (->* (list -Real) -Real -Real) - (->* (list N) N N))] -[+ (cl->* (->* '() -ExactPositiveInteger -ExactPositiveInteger) - (->* '() -Nat -Nat) - (->* '() -Integer -Integer) - (->* '() -ExactRational -ExactRational) - (->* '() -Flonum -Flonum) - (->* '() -Real -Real) - (->* '() N N))] -[- (cl->* (->* (list -Integer) -Integer -Integer) - (->* (list -ExactRational) -ExactRational -ExactRational) - (->* (list -Flonum) -Flonum -Flonum) - (->* (list -Real) -Real -Real) - (->* (list N) N N))] -[max (cl->* (->* (list -Integer) -Integer -Integer) - (->* (list N) N N))] -[min (cl->* (->* (list -Integer) -Integer -Integer) - (->* (list N) N N))] +[zero? (make-pred-ty (list N) B -Zero)] +[* (apply cl->* + (for/list ([t (list -Pos -Nat -Integer -ExactRational -Flonum -Real N)]) + (->* (list) t t)))] +[/ (apply cl->* + (for/list ([t (list -Integer -ExactRational -Flonum -Real N)]) + (->* (list t) t t)))] +[+ (apply cl->* + (for/list ([t (list -Pos -Nat -Integer -ExactRational -Flonum -Real N)]) + (->* (list) t t)))] +[- (apply cl->* + (for/list ([t (list -Integer -ExactRational -Flonum -Real N)]) + (->* (list t) t t)))] +[max (apply cl->* + (for/list ([t (list -Pos -Nat -Integer -ExactRational -Flonum -Real N)]) + (->* (list t) t t)))] +[min (apply cl->* + (for/list ([t (list -Pos -Nat -Integer -ExactRational -Flonum -Real N)]) + (->* (list t) t t)))] [positive? (-> N B)] [negative? (-> N B)] [odd? (-> -Integer B)] @@ -100,8 +90,12 @@ [denominator (N . -> . -Integer)] [rationalize (N N . -> . N)] [expt (cl->* (-Integer -Integer . -> . -Integer) (N N . -> . N))] -[sqrt (N . -> . N)] -[log (N . -> . N)] +[sqrt (cl->* + (-Real . -> . -Real) + (N . -> . N))] +[log (cl->* + (-Pos . -> . -Real) + (N . -> . N))] [exp (N . -> . N)] [cos (N . -> . N)] [sin (N . -> . N)] @@ -118,7 +112,13 @@ [sgn (-Real . -> . -Real)] [pi N] -[sqr (N . -> . N)] +[sqr (cl->* (-> -Pos -Pos) + (-> -Nat -Nat) + (-> -Integer -Integer) + (-> -ExactRational -ExactRational) + (-> -Flonum -Flonum) + (-> -Real -Real) + (-> N N))] [sgn (N . -> . N)] [conjugate (N . -> . N)] [sinh (N . -> . N)] diff --git a/collects/typed-scheme/types/subtype.ss b/collects/typed-scheme/types/subtype.ss index a2e961e3..be894406 100644 --- a/collects/typed-scheme/types/subtype.ss +++ b/collects/typed-scheme/types/subtype.ss @@ -226,17 +226,19 @@ [((Base: 'Integer _) (== -Real type-equal?)) A0] [((Base: 'Flonum _) (Base: 'Number _)) A0] [((Base: 'Exact-Rational _) (Base: 'Number _)) A0] + [((Base: 'Integer _) (Base: 'Exact-Rational _)) A0] [((Base: 'Exact-Positive-Integer _) (Base: 'Exact-Rational _)) A0] [((Base: 'Exact-Positive-Integer _) (Base: 'Number _)) A0] - [((Base: 'Exact-Positive-Integer _) (Base: 'Exact-Nonnegative-Integer _)) A0] + [((Base: 'Exact-Positive-Integer _) (== -Nat type-equal?)) A0] [((Base: 'Exact-Positive-Integer _) (Base: 'Integer _)) A0] - [((Base: 'Exact-Nonnegative-Integer _) (Base: 'Number _)) A0] - [((Base: 'Exact-Nonnegative-Integer _) (Base: 'Exact-Rational _)) A0] - [((Base: 'Exact-Nonnegative-Integer _) (Base: 'Integer _)) A0] + [((== -Nat type-equal?) (Base: 'Number _)) A0] + [((== -Nat type-equal?) (Base: 'Exact-Rational _)) A0] + [((== -Nat type-equal?) (Base: 'Integer _)) A0] ;; values are subtypes of their "type" - [((Value: (? integer? n)) (Base: 'Integer _)) A0] - [((Value: (? exact-nonnegative-integer? n)) (Base: 'Exact-Nonnegative-Integer _)) A0] + [((Value: (? exact-integer? n)) (Base: 'Integer _)) A0] + [((Value: (and n (? number?) (? exact?) (? rational?))) (Base: 'Exact-Rational _)) A0] + [((Value: (? exact-nonnegative-integer? n)) (== -Nat type-equal?)) A0] [((Value: (? exact-positive-integer? n)) (Base: 'Exact-Positive-Integer _)) A0] [((Value: (? inexact-real? n)) (Base: 'Flonum _)) A0] [((Value: (? real? n)) (== -Real type-equal?)) A0]