From 35608b36b4f44f6529b9dbd431d2bbcb61717602 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 13 Aug 2013 15:37:59 -0600
Subject: [PATCH] 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.
---
 racket/collects/setup/getinfo.rkt | 55 ++++++++++++++++++++++++-------
 1 file changed, 43 insertions(+), 12 deletions(-)

diff --git a/racket/collects/setup/getinfo.rkt b/racket/collects/setup/getinfo.rkt
index 3cc49a7877..214f5c1746 100644
--- a/racket/collects/setup/getinfo.rkt
+++ b/racket/collects/setup/getinfo.rkt
@@ -74,20 +74,47 @@
           ;; above (a guard will see other uses of #lang for stuff
           ;; that is required).
           ;; We are, however, trusting that the bytecode form of the
-          ;; file (if any) matches the source (except in bootstrap
-          ;; mode).
-          (parameterize ([current-namespace (or ns (info-namespace))])
-            (if bootstrap?
+          ;; file (if any) matches the source.
+          (let ([ns (or ns (info-namespace))])
+            (if (and bootstrap?
+                     (parameterize ([current-namespace ns])
+                       (not (module-declared? file))))
                 ;; Attach `info' language modules to target namespace, and
-                ;; disable the use of compiled bytecode:
-                (parameterize ([use-compiled-file-paths null])
-                  (namespace-attach-module enclosing-ns 'setup/infotab)
-                  (namespace-attach-module enclosing-ns 'setup/infotab/lang/reader)
-                  (namespace-attach-module enclosing-ns 'info)
-                  (namespace-attach-module enclosing-ns '(submod info reader))
-                  (dynamic-require file '#%info-lookup))
+                ;; disable the use of compiled bytecode if it fails; we
+                ;; need a trial namespace to try loading bytecode, since
+                ;; the use of bytecode "sticks" for later attempts.
+                (let ([attach!
+                       (lambda (ns)
+                         (namespace-attach-module enclosing-ns 'setup/infotab ns)
+                         (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.:
-                (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")])))
 
 (define info-namespace
@@ -101,6 +128,10 @@
             (set! ns-box (make-weak-box 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))
 ;; eg: (make-directory-record 1 0 '(lib "mzlib") #"mzlib" '(name))
 (define-struct directory-record (maj min spec path syms))