suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Two fixes in overlap checking.

Browse Source 
- 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.
This commit is contained in:
Stevie Strickland 2010-07-16 16:57:29 -04:00 committed by Vincent St-Amour
parent 8d6230956d
commit 654b7df1de
1 changed files with 12 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/typed-scheme/types/remove-intersect.rkt
View File

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