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)