From 39d6a6047a418a064a4dba47fae015f138d6a70a Mon Sep 17 00:00:00 2001 From: Andrew Kent Date: Tue, 5 Jul 2016 21:55:09 -0400 Subject: [PATCH] better rec type intersection --- typed-racket-lib/typed-racket/infer/intersect.rkt | 15 ++++++++++----- .../unit-tests/remove-intersect-tests.rkt | 8 +++++++- 2 files changed, 17 insertions(+), 6 deletions(-) diff --git a/typed-racket-lib/typed-racket/infer/intersect.rkt b/typed-racket-lib/typed-racket/infer/intersect.rkt index 9334ebb2..0484714f 100644 --- a/typed-racket-lib/typed-racket/infer/intersect.rkt +++ b/typed-racket-lib/typed-racket/infer/intersect.rkt @@ -22,7 +22,7 @@ ;; subtyping performs a similar check for the same ;; reason (let intersect - ([t1 t1] [t2 t2] [resolved (set)]) + ([t1 t1] [t2 t2] [resolved '()]) (match*/no-order (t1 t2) ;; already a subtype @@ -62,10 +62,15 @@ ;; resolve resolvable types if we haven't already done so [((? needs-resolving? t1) t2) #:no-order - #:when (not (or (set-member? resolved (cons t1 t2)) - (set-member? resolved (cons t2 t1)))) - (intersect (resolve t1) t2 (set-add resolved (cons t1 t2)))] - + #:when (not (member (cons t1 t2) resolved)) + (intersect (resolve t1) t2 (cons (cons t1 t2) resolved))] + + ;; if we're intersecting two recursive types, intersect their body + ;; and have their recursive references point back to the result + [((? Mu?) (? Mu?)) + (define name (gensym)) + (make-Mu name (intersect (Mu-body name t1) (Mu-body name t2) resolved))] + ;; t2 and t1 have a complex relationship, so we build an intersection ;; (note: intersection checks for overlap) [(t1 t2) (-unsafe-intersect t1 t2)]))) diff --git a/typed-racket-test/unit-tests/remove-intersect-tests.rkt b/typed-racket-test/unit-tests/remove-intersect-tests.rkt index b06e350a..0b92257c 100644 --- a/typed-racket-test/unit-tests/remove-intersect-tests.rkt +++ b/typed-racket-test/unit-tests/remove-intersect-tests.rkt @@ -52,7 +52,13 @@ [(-v a) -String (-unsafe-intersect (-v a) -String)] [-String (-v a) (-unsafe-intersect (-v a) -String)] [(-> -Number -Number) (-> -String -String) (-unsafe-intersect (-> -Number -Number) - (-> -String -String))])) + (-> -String -String))] + [(-mu x (Un (Un -Number -String) (-pair -Number x))) + (-mu x (Un (Un -Number -Symbol) (-pair -Number x))) + (-mu x (Un -Number (-pair -Number x)))] + [(make-Listof (-mu x (Un -String (-HT -String x)))) + (make-Listof (make-HashtableTop)) + (make-Listof (-HT -String (-mu x (Un -String (-HT -String x)))))])) (define-syntax (remo-tests stx) (syntax-case stx ()