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:
parent
619d6945c3
commit
5180e601db
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
|
@ -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)))
|
||||
|
|
Loading…
Reference in New Issue
Block a user