Reduce dependencies of TR's base-contracted.rkt

This reduces the dependencies of typed/racket/base. Avoid
bringing in type environment dependencies by manually constructing
a #%type-decl submodule.
This commit is contained in:
Asumu Takikawa 2014-04-13 12:07:48 -04:00
parent 4807dce556
commit 08bec9de9c
3 changed files with 31 additions and 36 deletions

View File

@ -4,44 +4,42 @@
;; contract protection, even in typed code.
(require "../utils/utils.rkt"
(env init-envs)
(types abbrev)
(utils any-wrap)
(only-in (rep type-rep)
make-Prompt-Tagof))
;; this submodule defines the contracted versions
(module contracted racket/base
(require racket/contract
(prefix-in c: racket/contract)
(rename-in
racket/base
[default-continuation-prompt-tag -default-continuation-prompt-tag])
"../utils/utils.rkt"
(utils any-wrap))
(for-syntax racket/base
(env env-req)))
(provide default-continuation-prompt-tag)
;; default tag should use Any wrappers
(define default-continuation-prompt-tag
(contract (-> (prompt-tag/c any-wrap/c #:call/cc any-wrap/c))
(c:contract (c:-> (c:prompt-tag/c any-wrap/c #:call/cc any-wrap/c))
-default-continuation-prompt-tag
;; TODO: we actually want to be able to specify that the
;; "contract from" party is not the untyped party
;; here, but that's not currently possible
'untyped 'typed)))
'untyped 'typed))
(require (for-template (submod "." contracted))
(submod "." contracted))
(begin-for-syntax
(add-mod! (variable-reference->module-path-index (#%variable-reference))))
(provide default-continuation-prompt-tag)
;; set up the type environment
(define-initial-env initialize-contracted
[default-continuation-prompt-tag
;; Set up a #%type-decl manually to avoid the overhead of bringing in
;; the "extra-env-lang.rkt" module
(begin-for-syntax
(module* #%type-decl #f
(#%plain-module-begin
(require typed-racket/env/global-env
typed-racket/types/abbrev
typed-racket/rep/type-rep)
(register-type
(quote-syntax default-continuation-prompt-tag)
;; TODO: we actually want the type
;; for the handler (->* (list) Univ ManyUniv)
;; but the prompt tag contract doesn't quite
;; support this (it needs a #:rest argument)
;;
;; Also, this type works better with inference.
(-> (make-Prompt-Tagof Univ (-> Univ ManyUniv)))])
(-> (make-Prompt-Tagof Univ (-> Univ ManyUniv)))))))

View File

@ -99,7 +99,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
"../typecheck/internal-forms.rkt"
(rename-in racket/contract/base [-> c->] [->* c->*] [case-> c:case->])
;; contracted bindings to replace built-in ones
(except-in "base-contracted.rkt" initialize-contracted)
"base-contracted.rkt"
"top-interaction.rkt"
"base-types.rkt"
"base-types-extra.rkt"

View File

@ -13,7 +13,6 @@
[typed-racket/base-env/base-structs (initialize-structs)]
[typed-racket/base-env/base-env-indexing (initialize-indexing)]
[typed-racket/base-env/base-special-env (initialize-special)]
[typed-racket/base-env/base-contracted (initialize-contracted)]
[(submod typed-racket/base-env/base-types initialize) (initialize-type-names)])
(define initialized #f)
@ -30,8 +29,6 @@
(do-time "Finshed base-env-numeric")
(initialize-special)
(do-time "Finished base-special-env")
(initialize-contracted)
(do-time "Finished base-contracted")
(initialize-type-names)
(do-time "Finished base-types")
(set! initialized #t))