From 5180e601db890a1d77744a4c0f796bd2ac7160ee Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Tue, 17 Feb 2015 11:37:44 -0500 Subject: [PATCH] Adjust the fix in 619d6945c3263d21e For unions of multiple type aliases the new placeholder would cause union collapsing incorrectly. Put an uninterned symbol in the placeholder types to avoid this. --- .../typed-racket/env/type-alias-helper.rkt | 20 +++++++++++++++---- .../typed-racket/env/type-name-env.rkt | 5 +++++ .../typed-racket/types/base-abbrev.rkt | 6 ------ typed-racket-test/succeed/gh-issue-26.rkt | 11 ++++++++++ 4 files changed, 32 insertions(+), 10 deletions(-) diff --git a/typed-racket-lib/typed-racket/env/type-alias-helper.rkt b/typed-racket-lib/typed-racket/env/type-alias-helper.rkt index e3eef92b..6db0d064 100644 --- a/typed-racket-lib/typed-racket/env/type-alias-helper.rkt +++ b/typed-racket-lib/typed-racket/env/type-alias-helper.rkt @@ -84,16 +84,25 @@ ;; Register type alias names with a dummy value so that it's in ;; scope for the registration later. ;; - ;; The `(make-Value (gensym))` expression is used to make sure + ;; The `(make-placeholder-type id)` expression is used to make sure ;; that unions don't collapse the aliases too soon. (register-resolved-type-alias id Err) (register-type-name id (if args - (make-Poly (map syntax-e args) -Alias-Placeholder) - -Alias-Placeholder)) + (make-Poly (map syntax-e args) (make-placeholder-type id)) + (make-placeholder-type id))) (values id (list id type-stx args)))) +;; Identifier -> Type +;; Construct a fresh placeholder type +(define (make-placeholder-type id) + (make-Base ;; the uninterned symbol here ensures that no two type + ;; aliases get the same placeholder type + (string->uninterned-symbol (symbol->string (syntax-e id))) + #'(int-err "Encountered unresolved alias placeholder") + (lambda _ #f) #f)) + ;; register-all-type-aliases : Listof Dict -> Void ;; ;; Given parsed type aliases and a type alias map, do the work @@ -199,7 +208,10 @@ ;; reverse order of that to avoid unbound type aliases. (for ([id (in-list acyclic-singletons)]) (define type-stx (car (dict-ref type-alias-map id))) - (register-resolved-type-alias id (parse-type type-stx))) + (register-resolved-type-alias id (parse-type type-stx)) + ;; unregister the type name to prevent TR from serializing useless + ;; placeholder names + (remove-type-name id)) ;; Clear the resolver cache of Name types from this block (define (reset-resolver-cache!) (resolver-cache-remove! name-types)) diff --git a/typed-racket-lib/typed-racket/env/type-name-env.rkt b/typed-racket-lib/typed-racket/env/type-name-env.rkt index 3b6682a2..857a1019 100644 --- a/typed-racket-lib/typed-racket/env/type-name-env.rkt +++ b/typed-racket-lib/typed-racket/env/type-name-env.rkt @@ -11,6 +11,7 @@ (types utils)) (provide register-type-name + remove-type-name lookup-type-name register-type-names add-alias @@ -36,6 +37,10 @@ (define (register-type-names ids types) (for-each register-type-name ids types)) +;; remove a name from the mapping +(define (remove-type-name id) + (free-id-table-remove! the-mapping id)) + ;; given an identifier, return the type associated with it ;; optional argument is failure continuation - default calls lookup-fail ;; identifier (-> error) -> type diff --git a/typed-racket-lib/typed-racket/types/base-abbrev.rkt b/typed-racket-lib/typed-racket/types/base-abbrev.rkt index f1500aa2..433f1e04 100644 --- a/typed-racket-lib/typed-racket/types/base-abbrev.rkt +++ b/typed-racket-lib/typed-racket/types/base-abbrev.rkt @@ -6,7 +6,6 @@ ;; extends it with more types and type abbreviations. (require "../utils/utils.rkt" - "../utils/tc-utils.rkt" (rep type-rep filter-rep object-rep rep-utils) (env mvar-env) racket/match racket/list (prefix-in c: (contract-req)) @@ -53,11 +52,6 @@ (define/decl -Symbol (make-Base 'Symbol #'symbol? symbol? #f)) (define/decl -String (make-Base 'String #'string? string? #f)) -;; Used by type-alias-helper.rkt for recursive alias placeholder values -(define/decl -Alias-Placeholder (make-Base 'Alias-Placeholder - #'(int-err "Encountered unresolved alias placeholder") - (lambda _ #f) #f)) - ;; Void is needed for Params (define/decl -Void (make-Base 'Void #'void? void? #f)) diff --git a/typed-racket-test/succeed/gh-issue-26.rkt b/typed-racket-test/succeed/gh-issue-26.rkt index 5c9db449..e353bfc7 100644 --- a/typed-racket-test/succeed/gh-issue-26.rkt +++ b/typed-racket-test/succeed/gh-issue-26.rkt @@ -8,3 +8,14 @@ (: x2 T2) (define x2 (set (list 'foo))) + +;; Demonstrates a bug in the initial fix +(define-type S2 (U Null (Pairof String S2))) +(define-type S3 (U Null (Pairof Integer S3))) +(define-type S1 (Listof (U S1 S2 S3))) + +(: y1 S1) +(define y1 (list (cons "foo" null))) + +(: y2 S1) +(define y2 (list (cons 3 null)))