From 82337641a2f74da6e7e8bcedf08bd197f6ece53e Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Sat, 16 Feb 2013 20:58:58 -0800
Subject: [PATCH] Fixes *-filter types and filter of zero?.

Closes PR13275.

original commit: 13b205aa0a6387fe40207753941cccb4c3bed61c
---
 .../typed-racket/unit-tests/typecheck-tests.rkt   | 15 ++++++++++++++-
 .../typed-racket/base-env/base-env-numeric.rkt    |  9 +++++++--
 collects/typed-racket/base-env/base-env.rkt       | 11 ++++++++---
 3 files changed, 29 insertions(+), 6 deletions(-)

diff --git a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt
index 28d6e8d8..536223c6 100644
--- a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt
+++ b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt
@@ -815,6 +815,19 @@
         [tc-e (filter even? (filter exact-integer? (list 1 2 3 'foo)))
               (-lst -Integer)]
 
+        [tc-e (filter (ann (λ: ((x : (U Symbol String)))
+                               (if (symbol? x) 'x #f)) ((U Symbol String) -> (U Symbol #f) : Symbol))
+                      (list "three" 'four 'five "six"))
+              (-lst -Symbol)]
+
+
+        [tc-e (vector-filter path-string? (ann (vector "a" 4 5 "b") (Vectorof Any)))
+              (-vec (t:Un -Path -String))]
+
+        [tc-e (sequence-filter module-path? (ann (vector "a" 4 5 "b") (Vectorof Any)))
+              (-seq (t:Un -Module-Path))]
+
+
         #|
         [tc-err (plambda: (a ...) [as : a ... a]
                           (apply fold-left (lambda: ([c : Integer] [a : Char] . [xs : a ... a]) c)
@@ -1535,7 +1548,7 @@
         [tc-e (sequence-count zero? (inst empty-sequence Integer))
               -Nat]
         [tc-e (sequence-filter zero? (inst empty-sequence Integer))
-              (-seq -Int)]
+              (-seq (-val 0))]
         [tc-e (sequence-add-between (inst empty-sequence Integer) 'foo)
               (-seq (t:Un -Int (-val 'foo)))]
         [tc-e (let ()
diff --git a/collects/typed-racket/base-env/base-env-numeric.rkt b/collects/typed-racket/base-env/base-env-numeric.rkt
index 2207bddf..429eb35a 100644
--- a/collects/typed-racket/base-env/base-env-numeric.rkt
+++ b/collects/typed-racket/base-env/base-env-numeric.rkt
@@ -703,8 +703,13 @@
 
 ;; numeric predicates
 ;; There are 25 values that answer true to zero?. They are either reals, or inexact complexes.
-[zero? (asym-pred N B (-FS (-filter (Un -RealZero -InexactComplex) 0)
-                           (-not-filter -RealZero 0)))]
+[zero?
+  (cl->*
+    (-> -ExactNumber B : (-FS (-filter (-val 0) 0) (-not-filter (-val 0) 0)))
+    (-> -Real B : (-FS (-filter -RealZero 0) (-not-filter -RealZero 0)))
+    (-> N B : (-FS (-filter (Un -RealZero -InexactComplex -InexactImaginary) 0)
+                   (-not-filter -RealZero 0))))]
+
 [number? (make-pred-ty N)]
 [integer? (asym-pred Univ B (-FS (-filter (Un -Int -Flonum -SingleFlonum) 0) ; inexact-integers exist...
                                  (-not-filter -Int 0)))]
diff --git a/collects/typed-racket/base-env/base-env.rkt b/collects/typed-racket/base-env/base-env.rkt
index 16d68cb8..83bcd400 100644
--- a/collects/typed-racket/base-env/base-env.rkt
+++ b/collects/typed-racket/base-env/base-env.rkt
@@ -418,7 +418,7 @@
                      [((a b c . -> . c) c (-lst a) (-lst b)) c]
                      [((a b c d . -> . d) d (-lst a) (-lst b) (-lst d)) d]))]
 [filter (-poly (a b) (cl->*
-                      ((asym-pred a -Boolean (-FS (-filter b 0) -top))
+                      ((asym-pred a Univ (-FS (-filter b 0) -top))
                        (-lst a)
                        . -> .
                        (-lst b))
@@ -970,7 +970,12 @@
 [sequence-for-each (-poly (a) ((a . -> . Univ) (-seq a) . -> . -Void))]
 [sequence-fold (-poly (a b) ((b a . -> . b) b (-seq a) . -> . b))]
 [sequence-count (-poly (a) ((a . -> . Univ) (-seq a) . -> . -Nat))]
-[sequence-filter (-poly (a) ((a . -> . Univ) (-seq a) . -> . (-seq a)))]
+[sequence-filter (-poly (a b) (cl->*
+                                ((asym-pred a Univ (-FS (-filter b 0) -top))
+                                 (-seq a)
+                                 . -> .
+                                 (-seq b))
+                                ((a . -> . Univ) (-lst a) . -> . (-seq a))))]
 [sequence-add-between (-poly (a) ((-seq a) a . -> . (-seq a)))]
 
 ;Section 3.16 (Sets)
@@ -1556,7 +1561,7 @@
                           . ->... .
                           -Index))]
 [vector-filter (-poly (a b) (cl->*
-                             ((make-pred-ty (list a) Univ b)
+                              ((asym-pred a Univ (-FS (-filter b 0) -top))
                               (-vec a)
                               . -> .
                               (-vec b))