Adjust the recursive type alias registration pass
Instead of registering aliases before we find out if they are recursive or not, register them after that information is found. That avoids spurious aliases that end up in the type name environment without the need for a `remove-type-name` operation.
This commit is contained in:
parent
425c584a30
commit
fed9ac40eb
|
@ -83,15 +83,7 @@
|
|||
(define-values (id type-stx args) (parse-type-alias type-alias))
|
||||
;; Register type alias names with a dummy value so that it's in
|
||||
;; scope for the registration later.
|
||||
;;
|
||||
;; 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) (make-placeholder-type id))
|
||||
(make-placeholder-type id)))
|
||||
(values id (list id type-stx args))))
|
||||
|
||||
;; Identifier -> Type
|
||||
|
@ -199,6 +191,17 @@
|
|||
(match-define (list _ args) record)
|
||||
(define name-type (make-Name id args #f))
|
||||
(register-resolved-type-alias id name-type)
|
||||
;; The `(make-placeholder-type id)` expression is used to make sure
|
||||
;; that unions don't collapse the aliases too soon. This is a dummy
|
||||
;; value that's used until the real type is found in the pass below.
|
||||
;;
|
||||
;; A type name should not be registered for non-recursive aliases
|
||||
;; because dummy values will leak due to environment serialization.
|
||||
(register-type-name
|
||||
id
|
||||
(if args
|
||||
(make-Poly (map syntax-e args) (make-placeholder-type id))
|
||||
(make-placeholder-type id)))
|
||||
name-type))
|
||||
|
||||
;; Register non-recursive type aliases
|
||||
|
@ -208,10 +211,7 @@
|
|||
;; 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))
|
||||
;; unregister the type name to prevent TR from serializing useless
|
||||
;; placeholder names
|
||||
(remove-type-name id))
|
||||
(register-resolved-type-alias id (parse-type type-stx)))
|
||||
|
||||
;; Clear the resolver cache of Name types from this block
|
||||
(define (reset-resolver-cache!) (resolver-cache-remove! name-types))
|
||||
|
|
|
@ -11,7 +11,6 @@
|
|||
(types utils))
|
||||
|
||||
(provide register-type-name
|
||||
remove-type-name
|
||||
lookup-type-name
|
||||
register-type-names
|
||||
add-alias
|
||||
|
@ -37,10 +36,6 @@
|
|||
(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
|
||||
|
|
Loading…
Reference in New Issue
Block a user