setup/getinfo: change bootstrap mode to try bytecode

Loading "info.rkt" files always from source turns out to be
expensive (adding 1 second or so on my machine to the startup
time for `raco setup'). Change bootstrap mode to try the compiled
form and fall back to source if its doesn't work.
This commit is contained in:
Matthew Flatt 2013-08-13 15:37:59 -06:00
parent 3f8475d6a9
commit 35608b36b4

View File

@ -74,20 +74,47 @@
;; above (a guard will see other uses of #lang for stuff ;; above (a guard will see other uses of #lang for stuff
;; that is required). ;; that is required).
;; We are, however, trusting that the bytecode form of the ;; We are, however, trusting that the bytecode form of the
;; file (if any) matches the source (except in bootstrap ;; file (if any) matches the source.
;; mode). (let ([ns (or ns (info-namespace))])
(parameterize ([current-namespace (or ns (info-namespace))]) (if (and bootstrap?
(if bootstrap? (parameterize ([current-namespace ns])
(not (module-declared? file))))
;; Attach `info' language modules to target namespace, and ;; Attach `info' language modules to target namespace, and
;; disable the use of compiled bytecode: ;; disable the use of compiled bytecode if it fails; we
(parameterize ([use-compiled-file-paths null]) ;; need a trial namespace to try loading bytecode, since
(namespace-attach-module enclosing-ns 'setup/infotab) ;; the use of bytecode "sticks" for later attempts.
(namespace-attach-module enclosing-ns 'setup/infotab/lang/reader) (let ([attach!
(namespace-attach-module enclosing-ns 'info) (lambda (ns)
(namespace-attach-module enclosing-ns '(submod info reader)) (namespace-attach-module enclosing-ns 'setup/infotab ns)
(dynamic-require file '#%info-lookup)) (namespace-attach-module enclosing-ns 'setup/infotab/lang/reader ns)
(namespace-attach-module enclosing-ns 'info ns)
(namespace-attach-module enclosing-ns '(submod info reader) ns))]
[try
(lambda (ns)
(parameterize ([current-namespace ns])
(dynamic-require file '#%info-lookup)))])
(define ns-id (namespace-module-registry ns))
((with-handlers ([exn:fail? (lambda (exn)
;; Trial namespace is damaged, so uncache:
(hash-set! trial-namespaces ns-id #f)
;; Try again from source:
(lambda ()
(attach! ns)
(parameterize ([use-compiled-file-paths null])
(try ns))))])
;; To reduce the cost of the trial namespace, try to used a cached
;; one previously generated for the `ns':
(define try-ns (or (hash-ref trial-namespaces ns-id #f)
(let ([try-ns (make-base-empty-namespace)])
(attach! try-ns)
try-ns)))
(define v (try try-ns))
(hash-set! trial-namespaces ns-id try-ns)
(namespace-attach-module try-ns file ns)
(lambda () v))))
;; Can use compiled bytecode, etc.: ;; Can use compiled bytecode, etc.:
(dynamic-require file '#%info-lookup)))] (parameterize ([current-namespace ns])
(dynamic-require file '#%info-lookup))))]
[else (err "does not contain a module of the right shape")]))) [else (err "does not contain a module of the right shape")])))
(define info-namespace (define info-namespace
@ -101,6 +128,10 @@
(set! ns-box (make-weak-box ns)) (set! ns-box (make-weak-box ns))
ns))))) ns)))))
;; Weak map from a namespace registry to a trial-loading namespace for
;; bootstrap mode:
(define trial-namespaces (make-weak-hasheq))
;; directory-record = (make-directory-record nat nat key path (listof symbol)) ;; directory-record = (make-directory-record nat nat key path (listof symbol))
;; eg: (make-directory-record 1 0 '(lib "mzlib") #"mzlib" '(name)) ;; eg: (make-directory-record 1 0 '(lib "mzlib") #"mzlib" '(name))
(define-struct directory-record (maj min spec path syms)) (define-struct directory-record (maj min spec path syms))