Adjust the fix in 619d6945c3

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.
This commit is contained in:
Asumu Takikawa 2015-02-17 11:37:44 -05:00
parent 619d6945c3
commit 5180e601db
4 changed files with 32 additions and 10 deletions

View File

@ -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<Id> Dict<Id, TypeAliasInfo> -> 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))

View File

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

View File

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

View File

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