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

Turn dynamic-requires into lazy-requires in TR.

Browse Source 
Closes PR 13621.
This commit is contained in:
Eric Dobson 2013-03-23 14:53:43 -07:00
parent 6c2e75ac7e
commit 04ef9db1b3
7 changed files with 54 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/typed-racket/unit-tests/parse-type-tests.rkt
View File

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

2
collects/tests/typed-racket/unit-tests/type-annotation-test.rkt
View File

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

2
collects/tests/typed-racket/unit-tests/typecheck-tests.rkt
View File

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

20
collects/typed-racket/base-env/prims.rkt
View File

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

18
collects/typed-racket/base-env/type-env-lang.rkt
View File

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

9
collects/typed-racket/tc-setup.rkt
View File

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

40
collects/typed-racket/typed-racket.rkt
View File

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