Make overlap more precise.

original commit: 19241c09792dc23ff0c633ab6406d5b9189a2e83
This commit is contained in:
Eric Dobson 2013-02-07 22:30:55 -08:00 committed by Vincent St-Amour
parent 5a77ece770
commit 72e090598d
2 changed files with 16 additions and 2 deletions

View File

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

View File

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