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:
Asumu Takikawa 2015-02-18 17:48:03 -05:00
parent 425c584a30
commit fed9ac40eb
2 changed files with 12 additions and 17 deletions

View File

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

View File

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