From 654b7df1decd52763ffedcdc507a4bf367b1cecf Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Fri, 16 Jul 2010 16:57:29 -0400 Subject: [PATCH] Two fixes in overlap checking. - Names were not being resolved, so a superstruct name and substruct name could be seen as non-overlapping. - Struct parents were not checked in the overlapping algorithm. --- .../typed-scheme/types/remove-intersect.rkt | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/collects/typed-scheme/types/remove-intersect.rkt b/collects/typed-scheme/types/remove-intersect.rkt index a646a54cda..074af5daf8 100644 --- a/collects/typed-scheme/types/remove-intersect.rkt +++ b/collects/typed-scheme/types/remove-intersect.rkt @@ -23,7 +23,8 @@ [(list _ (Univ:)) #t] [(list (F: _) _) #t] [(list _ (F: _)) #t] - [(list (Name: n) (Name: n*)) (free-identifier=? n n*)] + [(list (Name: n) (Name: n*)) + (overlap (resolve-once t1) (resolve-once t2))] [(list (? Mu?) _) (overlap (unfold t1) t2)] [(list _ (? Mu?)) (overlap t1 (unfold t2))] [(list (Union: e) t) @@ -68,12 +69,16 @@ [(list (Struct: n #f flds _ _ _ _ _) (StructTop: (Struct: n* #f flds* _ _ _ _ _))) #f] - [(list (Struct: n p flds _ _ _ _ _) - (Struct: n* p* flds* _ _ _ _ _)) - (and (= (length flds) (length flds*)) - (for/and ([f flds] [f* flds*]) - (match* (f f*) - [((fld: t _ _) (fld: t* _ _)) (overlap t t*)])))] + [(list (and t1 (Struct: n p flds _ _ _ _ _)) + (and t2 (Struct: n* p* flds* _ _ _ _ _))) + (let ([p1 (if (Name? p) (resolve-name p) p)] + [p2 (if (Name? p*) (resolve-name p*) p*)]) + (or (overlap t1 p2) + (overlap t2 p1) + (and (= (length flds) (length flds*)) + (for/and ([f flds] [f* flds*]) + (match* (f f*) + [((fld: t _ _) (fld: t* _ _)) (overlap t t*)])))))] [(list (== (-val eof)) (Function: _)) #f]