Fix `type-apply'

Fix duplicate filters

svn: r17522

original commit: a8e1c829c2e78744c20d6bd2b33bdb800f2a3b31

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"

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)))]

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)

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))]))