Make overlap more precise.
original commit: 19241c09792dc23ff0c633ab6406d5b9189a2e83
This commit is contained in:
parent
5a77ece770
commit
72e090598d
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue
Block a user