(module type-name-env mzscheme
(require (lib "boundmap.ss" "syntax") (lib "list.ss")
"tc-utils.ss")
(provide register-type-name
lookup-type-name
register-type-names
type-name-env-map)
(define the-mapping
(make-module-identifier-mapping))
(define (register-type-name id type)
(printf " registering type ~a~n" (syntax-e id))
(module-identifier-mapping-put! the-mapping id type))
(define (register-type-names ids types)
(for-each register-type-name ids types))
(define lookup-type-name
(case-lambda
[(id) (lookup-type-name id (lambda () (lookup-fail (syntax-e id))))]
[(id k) (module-identifier-mapping-get the-mapping id k)]))
(define (type-name-env-map f)
(module-identifier-mapping-map the-mapping f))
)