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:
parent
3f8475d6a9
commit
35608b36b4
|
@ -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))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user