diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss b/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss index 0a4636bf..b21e000b 100644 --- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss +++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss @@ -12,7 +12,7 @@ (rename-in (types utils union convenience) [Un t:Un] [-> t:->]) - (utils tc-utils) + (utils tc-utils utils) unstable/mutated-vars (env type-name-env type-environments init-envs) (schemeunit) @@ -768,6 +768,20 @@ (fact 20))] [tc-err (ann (lambda: ([x : Any]) #f) (Any -> Boolean : String))] + + + [tc-e (time (+ 3 4)) -ExactPositiveInteger] + + + + [tc-e + (call-with-values (lambda () (time-apply + (list 1 2))) + (lambda: ([v : (Listof Number)] + [cpu : Number] + [user : Number] + [gc : Number]) + 'whatever)) + #:ret (ret (-val 'whatever) (-FS (list) (list (make-Bot))))] ) (test-suite "check-type tests" diff --git a/collects/typed-scheme/private/base-env.ss b/collects/typed-scheme/private/base-env.ss index 419a0499..27b75eb8 100644 --- a/collects/typed-scheme/private/base-env.ss +++ b/collects/typed-scheme/private/base-env.ss @@ -233,12 +233,20 @@ [apply (-poly (a b) (((list) a . ->* . b) (-lst a) . -> . b))] [kernel:apply (-poly (a b) (((list) a . ->* . b) (-lst a) . -> . b))] -[time-apply (-polydots (b a) - (make-Function - (list (make-arr - (list ((list) (a a) . ->... . b) - (-lst a)) - (-values (list (-pair b (-val '())) -Nat -Nat -Nat))))))] +[time-apply (-poly (a b c) + (cl->* + (-> + (-> a) + (-Tuple (list)) + (-values (list (-pair a (-val '())) -Nat -Nat -Nat))) + (-> + (-> b a) + (-Tuple (list b)) + (-values (list (-pair a (-val '())) -Nat -Nat -Nat))) + (-> + (-> b c a) + (-Tuple (list b c)) + (-values (list (-pair a (-val '())) -Nat -Nat -Nat)))))] [call/cc (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (Un a b)))] [call/ec (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (Un a b)))] diff --git a/collects/typed-scheme/typecheck/tc-metafunctions.ss b/collects/typed-scheme/typecheck/tc-metafunctions.ss index 39d44def..2e790129 100644 --- a/collects/typed-scheme/typecheck/tc-metafunctions.ss +++ b/collects/typed-scheme/typecheck/tc-metafunctions.ss @@ -87,7 +87,7 @@ (define (merge-filter-sets fs) (match fs [(list (FilterSet: f+ f-) ...) - (make-FilterSet (apply append f+) (apply append f-))])) + (make-FilterSet (remove-duplicates (apply append f+)) (remove-duplicates (apply append f-)))])) (d/c (apply-filter lfs t o) (-> LatentFilterSet/c Type/c Object? FilterSet/c) diff --git a/collects/typed-scheme/utils/utils.ss b/collects/typed-scheme/utils/utils.ss index 8300d461..9f2797f2 100644 --- a/collects/typed-scheme/utils/utils.ss +++ b/collects/typed-scheme/utils/utils.ss @@ -94,7 +94,7 @@ at least theoretically. e)))] [(_ . args) (begin (printf "starting ~a~n" 'args) - (let ([e args]) + (let ([e (begin . args)]) (printf "result was ~a~n" e) e))]))