From 04ef9db1b31496bb9ec93f8f7899c04acf3d1230 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Sat, 23 Mar 2013 14:53:43 -0700 Subject: [PATCH] Turn dynamic-requires into lazy-requires in TR. Closes PR 13621. --- .../unit-tests/parse-type-tests.rkt | 2 +- .../unit-tests/type-annotation-test.rkt | 2 +- .../unit-tests/typecheck-tests.rkt | 2 +- collects/typed-racket/base-env/prims.rkt | 20 ++++------ .../typed-racket/base-env/type-env-lang.rkt | 18 +++++---- collects/typed-racket/tc-setup.rkt | 9 ++--- collects/typed-racket/typed-racket.rkt | 40 ++++++++++++++----- 7 files changed, 54 insertions(+), 39 deletions(-) diff --git a/collects/tests/typed-racket/unit-tests/parse-type-tests.rkt b/collects/tests/typed-racket/unit-tests/parse-type-tests.rkt index 5aa93f7afb..1ca848c8a6 100644 --- a/collects/tests/typed-racket/unit-tests/parse-type-tests.rkt +++ b/collects/tests/typed-racket/unit-tests/parse-type-tests.rkt @@ -30,7 +30,7 @@ [ty (cdr pr)]) (register-resolved-type-alias (datum->syntax #'here (syntax->datum nm)) ty))) -(dynamic-require '(submod typed-racket/base-env/base-types #%type-decl) #f) +((dynamic-require '(submod typed-racket/base-env/base-types initialize) 'initialize-type-names)) (define-syntax (run-one stx) (syntax-case stx () diff --git a/collects/tests/typed-racket/unit-tests/type-annotation-test.rkt b/collects/tests/typed-racket/unit-tests/type-annotation-test.rkt index ad921a2013..c562ad5a86 100644 --- a/collects/tests/typed-racket/unit-tests/type-annotation-test.rkt +++ b/collects/tests/typed-racket/unit-tests/type-annotation-test.rkt @@ -9,7 +9,7 @@ (rep type-rep filter-rep object-rep) rackunit) -(dynamic-require '(submod typed-racket/base-env/base-types #%type-decl) #f) +((dynamic-require '(submod typed-racket/base-env/base-types initialize) 'initialize-type-names)) (provide type-annotation-tests) diff --git a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt index 932272717d..a2c1ebe6ec 100644 --- a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt +++ b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt @@ -42,7 +42,7 @@ (provide typecheck-tests g) (b:init) (n:init) (initialize-structs) (initialize-indexing) -(dynamic-require '(submod typed-racket/base-env/base-types #%type-decl) #f) +((dynamic-require '(submod typed-racket/base-env/base-types initialize) 'initialize-type-names)) (define N -Number) (define B -Boolean) diff --git a/collects/typed-racket/base-env/prims.rkt b/collects/typed-racket/base-env/prims.rkt index bfe6368402..2cc3209f81 100644 --- a/collects/typed-racket/base-env/prims.rkt +++ b/collects/typed-racket/base-env/prims.rkt @@ -64,22 +64,17 @@ This file defines two sorts of primitives. All of them are provided into any mod racket/vector) (provide index?) ; useful for assert, and racket doesn't have it +;; Lazily loaded b/c they're only used sometimes, so we save a lot +;; of loading by not having them when they are unneeded (begin-for-syntax (lazy-require ["../rep/type-rep.rkt" (make-Opaque Error?)] - [syntax/define (normalize-definition)])) + [syntax/define (normalize-definition)] + [typed-racket/private/parse-type (parse-type)] + [typed-racket/private/type-contract (type->contract)] + [typed-racket/env/type-name-env (register-type-name)])) (define-for-syntax (ignore stx) (syntax-property stx 'typechecker:ignore #t)) -;; dynamically loaded b/c they're only used at the top-level, so we save a lot -;; of loading by not having them when we're in a module -(define-for-syntax (parse-type stx) ((dynamic-require 'typed-racket/private/parse-type 'parse-type) stx)) -(define-for-syntax type->contract - (make-keyword-procedure - (lambda (kws kw-args . rest) - (keyword-apply - (dynamic-require 'typed-racket/private/type-contract 'type->contract) - kws kw-args rest)))) - (define-syntaxes (require/typed-legacy require/typed) (let () (define-syntax-class opt-rename @@ -293,8 +288,7 @@ This file defines two sorts of primitives. All of them are provided into any mod (pattern #:name-exists)) (syntax-parse stx [(_ ty:id pred:id lib (~optional ne:name-exists-kw) ...) - ((dynamic-require 'typed-racket/env/type-name-env 'register-type-name) - #'ty (make-Opaque #'pred (syntax-local-certifier))) + (register-type-name #'ty (make-Opaque #'pred (syntax-local-certifier))) (with-syntax ([hidden (generate-temporary #'pred)]) (quasisyntax/loc stx (begin diff --git a/collects/typed-racket/base-env/type-env-lang.rkt b/collects/typed-racket/base-env/type-env-lang.rkt index 14210d9314..f2a79477aa 100644 --- a/collects/typed-racket/base-env/type-env-lang.rkt +++ b/collects/typed-racket/base-env/type-env-lang.rkt @@ -3,22 +3,24 @@ (require (for-syntax racket/base syntax/parse)) (define-syntax (#%module-begin stx) - (syntax-parse stx #:literals (require provide) + (syntax-parse stx #:literals (require) [(mb (require . args) ... [nm:id ty] ...) #'(#%plain-module-begin - (begin - (define-syntax (nm stx) - (raise-syntax-error + (begin + (define-syntax (nm stx) + (raise-syntax-error 'type-check "type name used out of context" stx)) ... (provide nm) ... (begin-for-syntax - (module* #%type-decl #f - (require + (module* initialize #f + (require (only-in typed-racket/env/init-envs initialize-type-name-env)) (require . args) ... - (initialize-type-name-env - (list (list #'nm ty) ...))))))])) + (provide initialize-type-names) + (define (initialize-type-names) + (initialize-type-name-env + (list (list #'nm ty) ...)))))))])) (provide #%module-begin require (all-from-out racket/base) diff --git a/collects/typed-racket/tc-setup.rkt b/collects/typed-racket/tc-setup.rkt index 2b4520a750..9e24036e7d 100644 --- a/collects/typed-racket/tc-setup.rkt +++ b/collects/typed-racket/tc-setup.rkt @@ -2,7 +2,7 @@ (require "utils/utils.rkt" (except-in syntax/parse id) - racket/pretty racket/promise + racket/pretty racket/promise racket/lazy-require (private type-contract) (types utils) (typecheck typechecker provide-handling tc-toplevel) @@ -11,6 +11,7 @@ (rep type-rep) (for-syntax racket/base) (for-template racket/base)) +(lazy-require [typed-racket/optimizer/optimizer (optimize-top)]) (provide tc-setup invis-kw maybe-optimize) @@ -21,10 +22,8 @@ (define (maybe-optimize body) ;; do we optimize? (if (optimize?) - (let ([optimize-top - (begin0 (dynamic-require 'typed-racket/optimizer/optimizer - 'optimize-top) - (do-time "Loading optimizer"))]) + (begin + (do-time "Starting optimizer") (begin0 (map optimize-top (syntax->list body)) (do-time "Optimized"))) body)) diff --git a/collects/typed-racket/typed-racket.rkt b/collects/typed-racket/typed-racket.rkt index 9d9569f9ef..dd37618afb 100644 --- a/collects/typed-racket/typed-racket.rkt +++ b/collects/typed-racket/typed-racket.rkt @@ -1,7 +1,7 @@ #lang racket/base (require - (for-syntax racket/base "env/env-req.rkt") + (for-syntax racket/base racket/lazy-require "env/env-req.rkt") (for-syntax "utils/timing.rkt") ;; only for timing/debugging ;; the below requires are needed since they provide identifiers ;; that may appear in the residual program @@ -14,34 +14,54 @@ with-type (for-syntax do-standard-inits)) +(module init-base-env racket/base + (require racket/lazy-require) + (provide (rename-out (init init-base-env))) + (lazy-require (typed-racket/base-env/base-env (init)))) +(module init-base-env-numeric racket/base + (require racket/lazy-require) + (provide (rename-out (init init-base-env-numeric))) + (lazy-require (typed-racket/base-env/base-env-numeric (init)))) + +(begin-for-syntax + (require 'init-base-env) + (require 'init-base-env-numeric) + (lazy-require + [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-for-syntax initialized #f) (define-for-syntax (do-standard-inits) (unless initialized (do-time "Starting initialization") - ((dynamic-require 'typed-racket/base-env/base-structs 'initialize-structs)) + (initialize-structs) (do-time "Finshed base-structs") - ((dynamic-require 'typed-racket/base-env/base-env-indexing 'initialize-indexing)) + (initialize-indexing) (do-time "Finshed base-env-indexing") - ((dynamic-require 'typed-racket/base-env/base-env 'init)) + (init-base-env) (do-time "Finshed base-env") - ((dynamic-require 'typed-racket/base-env/base-env-numeric 'init)) + (init-base-env-numeric) (do-time "Finshed base-env-numeric") - ((dynamic-require 'typed-racket/base-env/base-special-env 'initialize-special)) + (initialize-special) (do-time "Finished base-special-env") - ((dynamic-require 'typed-racket/base-env/base-contracted 'initialize-contracted)) + (initialize-contracted) (do-time "Finished base-contracted") - (dynamic-require '(submod typed-racket/base-env/base-types #%type-decl) #f) + (initialize-type-names) (do-time "Finished base-types") (set! initialized #t)) (do-requires)) (define-syntax-rule (drivers [name sym] ...) (begin + (begin-for-syntax + (lazy-require (typed-racket/core (sym ...)))) (define-syntax (name stx) (do-time (format "Calling ~a driver" 'name)) - (define f (dynamic-require 'typed-racket/core 'sym)) (do-time (format "Loaded core ~a" 'sym)) - (begin0 (f stx do-standard-inits) + (begin0 (sym stx do-standard-inits) (do-time "Finished, returning to Racket"))) ...))