From ed1696b2212efd822f584e21b2e2eaed456a66b2 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Tue, 28 Oct 2014 12:02:02 -0400 Subject: [PATCH] Avoid requires of contracts when they're not used. This changes when various libraries that provide contract support to possible contracted bindings to declare when those bindings are needed. Probably, each static-contract combinator should manually add to the list, instead of having one fixed static list, but this is a start. Saves about 10ms in startup for an empty TR module on my laptop. Thanks to Robby for the idea. original commit: 8ea8c54eb47faac7c0d8bcd868a9b12f8ea2e142 --- .../typed-racket-lib/typed-racket/core.rkt | 9 ++++++++- .../typed-racket/private/type-contract.rkt | 19 +++++++++++++++++-- .../typed-racket/private/with-types.rkt | 15 +++++++++------ .../typecheck/provide-handling.rkt | 3 ++- .../typed-racket/typed-racket.rkt | 11 +---------- 5 files changed, 37 insertions(+), 20 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/core.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/core.rkt index 2d077184..f3eebb3e 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/core.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/core.rkt @@ -44,7 +44,11 @@ 'disappeared-use (disappeared-use-todo))]) ;; reconstruct the module with the extra code ;; use the regular %#module-begin from `racket/base' for top-level printing - (arm #`(#%module-begin #,before-code optimized-body ... #,after-code check-syntax-help)))))))])) + (arm #`(#%module-begin + #,(if (unbox include-extra-requires?) + extra-requires + #'(begin)) + #,before-code optimized-body ... #,after-code check-syntax-help)))))))])) (define did-I-suggest-:print-type-already? #f) (define :print-type-message " ... [Use (:print-type ) to see more.]") @@ -112,5 +116,8 @@ [x (int-err "bad type result: ~a" x)])]) (if ty-str #`(begin (display '#,ty-str) + #,(if (unbox include-extra-requires?) + extra-requires + #'(begin)) #,(arm #'optimized-body)) (arm #'optimized-body)))]))))])) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt index f8d598b9..527b4cc5 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt @@ -32,7 +32,7 @@ (#:typed-side boolean?) . c:->* . (c:or/c a static-contract?)))])) (provide type->contract define/fixup-contract? change-contract-fixups - type->contract-fail any-wrap/sc) + type->contract-fail any-wrap/sc extra-requires include-extra-requires?) ;; These check if either the define form or the body form has the syntax ;; property. Normally the define form will have the property but lifting an @@ -95,11 +95,26 @@ [_ (int-err "should never happen - not a define-values: ~a" (syntax->datum stx))])) +(define extra-requires + #'(require + ;; the below requires are needed since they provide identifiers + ;; that may appear in the residual program + (submod typed-racket/private/type-contract predicates) + typed-racket/utils/utils + (for-syntax typed-racket/utils/utils) + typed-racket/utils/any-wrap typed-racket/utils/struct-type-c + typed-racket/utils/evt-contract + unstable/contract racket/contract/parametric)) + +;; should the above requires be included in the output? +(define include-extra-requires? (box #f)) + (define (change-contract-fixups forms) (for/list ((e (in-syntax forms))) (if (not (define/fixup-contract? e)) e - (generate-contract-def e)))) + (begin (set-box! include-extra-requires? #t) + (generate-contract-def e))))) ;; To avoid misspellings (define impersonator-sym 'impersonator) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/with-types.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/with-types.rkt index d2e5621f..85a656dc 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/with-types.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/with-types.rkt @@ -117,14 +117,17 @@ (arm (if expr? (quasisyntax/loc stx - (begin check-syntax-help - (c:with-contract typed-region - #:results (region-cnt ...) - #:freevars ([fv.id cnt] ...) - #,fixed-up-definitions - body))) + (let () + check-syntax-help + (local-require #,@(cdr (syntax-e extra-requires))) + (c:with-contract typed-region + #:results (region-cnt ...) + #:freevars ([fv.id cnt] ...) + #,fixed-up-definitions + body))) (quasisyntax/loc stx (begin + (local-require #,@(cdr (syntax-e extra-requires))) (define-values () (begin check-syntax-help (values))) (c:with-contract typed-region ([ex-id ex-cnt] ...) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/provide-handling.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/provide-handling.rkt index 6628f881..2f29c4a2 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/provide-handling.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/provide-handling.rkt @@ -3,7 +3,7 @@ (require "../utils/utils.rkt" unstable/list unstable/sequence syntax/id-table racket/dict racket/syntax racket/struct-info racket/match syntax/parse - (only-in (private type-contract) type->contract) + (only-in (private type-contract) type->contract include-extra-requires?) (types printer) (typecheck renamer def-binding) (utils tc-utils) @@ -171,5 +171,6 @@ (define provide-forms (for/list ([external-id (in-list external-ids)]) #`(rename-out [#,id #,external-id]))) + (when (pair? external-ids) (set-box! include-extra-requires? #t)) (values #`(begin #,defs (provide #,@provide-forms)) alias))) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typed-racket.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typed-racket.rkt index 0b896195..45bad09e 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typed-racket.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typed-racket.rkt @@ -3,16 +3,7 @@ (require (for-syntax racket/base racket/lazy-require "standard-inits.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 - ;; TODO: figure out why this are needed here and not somewhere else - (submod "private/type-contract.rkt" predicates) - "utils/utils.rkt" - (for-syntax "utils/utils.rkt") - "utils/any-wrap.rkt" "utils/struct-type-c.rkt" - "utils/evt-contract.rkt" - unstable/contract racket/contract/parametric) + (for-syntax "utils/timing.rkt")) ;; only for timing/debugging (provide (rename-out [module-begin #%module-begin] [top-interaction #%top-interaction])