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

Change overlap for structs in TR. Closes PR11390.

Browse Source
This commit is contained in:
Eric Dobson 2011-09-05 00:34:55 -07:00 committed by Sam Tobin-Hochstadt
parent 53ce20d3f9
commit 32becc2e0a
2 changed files with 25 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/tests/typed-racket/succeed/pr11390.rkt Normal file
View File

@ -0,0 +1,22 @@
#lang typed/racket
;Doesn't TypeCheck
(struct: foo ())
(struct: foo-num foo ((v : Number)))
(struct: foo-str foo ((v : String)))
#|
;TypeChecks
(struct: foo-num ((v : Number)))
(struct: foo-str ((v : String)))
|#
(: extract-foo (case-lambda
(foo-num -> Number)
(foo-str -> String)))
(define (extract-foo foo)
(cond
((foo-num? foo) (foo-num-v foo))
((foo-str? foo) (foo-str-v foo))))

13
collects/typed-racket/types/remove-intersect.rkt
View File

@ -80,16 +80,9 @@
[(list (Struct: n #f flds _ _ _ _ _)
(StructTop: (Struct: n* #f flds* _ _ _ _ _)))
#f]
[(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 (and p2 (overlap t1 p2))
(and p1 (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 (and t1 (Struct: _ _ _ _ _ _ _ _))
(and t2 (Struct: _ _ _ _ _ _ _ _)))
(or (subtype t1 t2) (subtype t2 t1))]
[(list (== (-val eof))
(Function: _))
#f]