From 72e090598dd0a2b302cfb9e5c8d58c4f1fd4ac69 Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Thu, 7 Feb 2013 22:30:55 -0800
Subject: [PATCH] Make overlap more precise.

original commit: 19241c09792dc23ff0c633ab6406d5b9189a2e83
---
 .../unit-tests/remove-intersect-tests.rkt        |  2 ++
 collects/typed-racket/types/remove-intersect.rkt | 16 ++++++++++++++--
 2 files changed, 16 insertions(+), 2 deletions(-)

diff --git a/collects/tests/typed-racket/unit-tests/remove-intersect-tests.rkt b/collects/tests/typed-racket/unit-tests/remove-intersect-tests.rkt
index 601db130..f8f0711b 100644
--- a/collects/tests/typed-racket/unit-tests/remove-intersect-tests.rkt
+++ b/collects/tests/typed-racket/unit-tests/remove-intersect-tests.rkt
@@ -38,6 +38,8 @@
    [-Listof -Sexp (-lst (Un B N -String Sym))]
    #;
    [-Sexp -Listof (-lst -Sexp)]
+   [(-val "one") -Fixnum (Un)]
+   [(Un (-val "one") (-val "two")) (Un (-val "one") (-val 1)) (-val "one")]
    ))
 
 (define-syntax (remo-tests stx)
diff --git a/collects/typed-racket/types/remove-intersect.rkt b/collects/typed-racket/types/remove-intersect.rkt
index e9246931..8b539dff 100644
--- a/collects/typed-racket/types/remove-intersect.rkt
+++ b/collects/typed-racket/types/remove-intersect.rkt
@@ -7,6 +7,15 @@
 
 (provide (rename-out [*remove remove]) overlap)
 
+(define (simple-datum? v)
+  (or (null? v)
+      (symbol? v)
+      (number? v)
+      (boolean? v)
+      (pair? v)
+      (string? v)
+      (keyword? v)))
+
 
 (define (overlap t1 t2)
   (let ([ks (Type-key t1)] [kt (Type-key t2)])
@@ -66,10 +75,13 @@
          [(or (list (Pair: _ _) _)
               (list _ (Pair: _ _)))
           #f]
-         [(or (list (Value: (? (λ (e) (or (null? e) (symbol? e) (number? e) (boolean? e) (pair? e) (keyword? e)))))
+         [(list (Value: (? simple-datum? v1))
+                (Value: (? simple-datum? v2)))
+          (equal? v1 v2)]
+         [(or (list (Value: (? simple-datum?))
                     (Struct: n _ flds _ _ _))
               (list (Struct: n _ flds _ _ _) 
-                    (Value: (? (λ (e) (or (null? e) (symbol? e) (number? e) (boolean? e) (pair? e) (keyword? e)))))))
+                    (Value: (? simple-datum?))))
           #f]
          [(list (Struct: n _ flds _ _ _)
                 (Struct: n* _ flds* _ _ _)) (=> nevermind)