suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Reduce dependencies of TR's base-contracted.rkt

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-contracted.rkt
View File

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

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt
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" "../typecheck/internal-forms.rkt"
(rename-in racket/contract/base [-> c->] [->* c->*] [case-> c:case->]) (rename-in racket/contract/base [-> c->] [->* c->*] [case-> c:case->])
;; contracted bindings to replace built-in ones ;; contracted bindings to replace built-in ones
(except-in "base-contracted.rkt" initialize-contracted) "base-contracted.rkt"
"top-interaction.rkt" "top-interaction.rkt"
"base-types.rkt" "base-types.rkt"
"base-types-extra.rkt" "base-types-extra.rkt"

3
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/standard-inits.rkt
View File

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