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.
This commit is contained in:
parent
ed0fa5da5b
commit
8ea8c54eb4
|
@ -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 <expr>) 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)))]))))]))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -117,7 +117,9 @@
|
|||
(arm
|
||||
(if expr?
|
||||
(quasisyntax/loc stx
|
||||
(begin check-syntax-help
|
||||
(let ()
|
||||
check-syntax-help
|
||||
(local-require #,@(cdr (syntax-e extra-requires)))
|
||||
(c:with-contract typed-region
|
||||
#:results (region-cnt ...)
|
||||
#:freevars ([fv.id cnt] ...)
|
||||
|
@ -125,6 +127,7 @@
|
|||
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] ...)
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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])
|
||||
|
|
Loading…
Reference in New Issue
Block a user