repair and performance improvement for require traversals

The `namespace-attach-module` function did not work right for a module
dependency that runs code at a phase level shifted to phase 0 while
the module's instantiation phase is non-0.

Internally, `require` module-name resolutions are cached differently
so that they can be shared as modules are attached. This change can
greatly reduce calls to the module name resolver when creating many
sandboxes for the same language, such as when rendering documentation.

Unnecessary traversal of module requires is now skipped in the case of
visiting available modules. In addition, a new `#:flatten-requires`
option in the `#%declare` form provides a hint that it's worth
flattening the tree of requires within a module's compiled form. This
flattening is now always a win; if two modules that have flattened
`require`s share a large subtree, and if those two modules are
required by a third, then instantiating the third can be slower than
without flattening. Flattening sparingly at the level of modules that
are often attached to oter namespaces, however, is likely to be
worthwhile. The `racket/base` module is marked `#:flatten-requires`,
and that helps make `(make-base-namespace)` twice as fast as before.

pkgs/base/info.rkt

@@ -14,7 +14,7 @@
 
 ;; In the Racket source repo, this version should change exactly when
 ;; "racket_version.h" changes:
-(define version "8.13.0.3")
+(define version "8.13.0.4")
 
 (define deps `("racket-lib"
                ["racket" #:version ,version]))

pkgs/compiler-lib/compiler/decompile.rkt

@@ -108,7 +108,7 @@
                                   #:when (exact-integer? k))
                          k)
                        <))
-  (define-values (mpi-vector requires recur-requires provides phase-to-link-modules)
+  (define-values (mpi-vector requires recur-requires flattened-requires provides phase-to-link-modules)
     (deserialize-requires-and-provides l))
   (define (phase-wrap phase l)
     (case phase
@@ -117,66 +117,78 @@
       [(-1) `((for-template ,@l))]
       [(#f) `((for-label ,@l))]
       [else `((for-meta ,phase ,@l))]))
-  `(module ,(hash-ref ht 'name 'unknown) ....
-     (require ,@(apply
-                 append
-                 (for/list ([phase+mpis (in-list requires)])
-                   (phase-wrap (car phase+mpis)
-                               (map collapse-module-path-index (cdr phase+mpis))))))
-     (quote (recurs: ,@(apply
-                        append
-                        (for/list ([phase+mpis (in-list requires)]
-                                   [recurs (in-list recur-requires)])
-                          (phase-wrap (car phase+mpis)
-                                      (for/list ([mpi (cdr phase+mpis)]
-                                                 [recur? (in-list recurs)]
-                                                 #:when recur?)
-                                        (collapse-module-path-index mpi)))))))
-     (provide ,@(apply
-                 append
-                 (for/list ([(phase ht) (in-hash provides)])
-                   (phase-wrap phase (hash-keys ht)))))
-     ,@(let loop ([phases phases] [depth 0])
-         (cond
-           [(null? phases) '()]
-           [(= depth (car phases))
-            (append
-             (decompile-linklet (hash-ref ht (car phases)) #:just-body? #t)
-             (loop (cdr phases) depth))]
-           [else
-            (define l (loop phases (add1 depth)))
-            (define (convert-syntax-definition s wrap)
-              (match s
-                [`(let ,bindings ,body)
-                 (convert-syntax-definition body
-                                            (lambda (rhs)
-                                              `(let ,bindings
-                                                 ,rhs)))]
-                [`(begin (.set-transformer! ',id ,rhs) ',(? void?))
-                 `(define-syntaxes ,id ,(wrap rhs))]
-                [`(begin (.set-transformer! ',ids ,rhss) ... ',(? void?))
-                 `(define-syntaxes ,ids ,(wrap `(values . ,rhss)))]
-                [_ #f]))
-            (let loop ([l l] [accum '()])
-              (cond
-                [(null? l) (if (null? accum)
-                               '()
-                               `((begin-for-syntax ,@(reverse accum))))]
-                [(convert-syntax-definition (car l) values)
-                 => (lambda (s)
-                      (append (loop null accum)
-                              (cons s (loop (cdr l) null))))]
-                [else
-                 (loop (cdr l) (cons (car l) accum))]))]))
-     ,@(get-nested)
-     ,@(let ([l (hash-ref ht 'stx-data #f)])
-         (if l
-             `((begin-for-all
-                 (define (.get-syntax-literal! pos)
-                   ....
-                   ,@(decompile-data-linklet l)
-                   ....)))
-             null))))
+  (define the-mod
+    `(module ,(hash-ref ht 'name 'unknown) ....
+       (require ,@(apply
+                   append
+                   (for/list ([phase+mpis (in-list requires)])
+                     (phase-wrap (car phase+mpis)
+                                 (map collapse-module-path-index (cdr phase+mpis))))))
+       (quote (recurs: ,@(apply
+                          append
+                          (for/list ([phase+mpis (in-list requires)]
+                                     [recurs (in-list recur-requires)])
+                            (phase-wrap (car phase+mpis)
+                                        (for/list ([mpi (cdr phase+mpis)]
+                                                   [recur? (in-list recurs)]
+                                                   #:when recur?)
+                                          (collapse-module-path-index mpi)))))))
+       ,@(if flattened-requires
+             `((quote (flattened: ,@(for/list ([mpi/boxed+phases (in-list flattened-requires)])
+                                      (define mpi/boxed (vector-ref mpi/boxed+phases 0))
+                                      (define mpi (if (box? mpi/boxed) (unbox mpi/boxed) mpi/boxed))
+                                      (cons (let ([mpi (collapse-module-path-index mpi)])
+                                              (if (box? mpi/boxed)
+                                                  (box mpi)
+                                                  mpi))
+                                            (vector-ref mpi/boxed+phases 1))))))
+             null)
+       (provide ,@(apply
+                   append
+                   (for/list ([(phase ht) (in-hash provides)])
+                     (phase-wrap phase (hash-keys ht)))))
+       ,@(let loop ([phases phases] [depth 0])
+           (cond
+             [(null? phases) '()]
+             [(= depth (car phases))
+              (append
+               (decompile-linklet (hash-ref ht (car phases)) #:just-body? #t)
+               (loop (cdr phases) depth))]
+             [else
+              (define l (loop phases (add1 depth)))
+              (define (convert-syntax-definition s wrap)
+                (match s
+                  [`(let ,bindings ,body)
+                   (convert-syntax-definition body
+                                              (lambda (rhs)
+                                                `(let ,bindings
+                                                     ,rhs)))]
+                  [`(begin (.set-transformer! ',id ,rhs) ',(? void?))
+                   `(define-syntaxes ,id ,(wrap rhs))]
+                  [`(begin (.set-transformer! ',ids ,rhss) ... ',(? void?))
+                   `(define-syntaxes ,ids ,(wrap `(values . ,rhss)))]
+                  [_ #f]))
+              (let loop ([l l] [accum '()])
+                (cond
+                  [(null? l) (if (null? accum)
+                                 '()
+                                 `((begin-for-syntax ,@(reverse accum))))]
+                  [(convert-syntax-definition (car l) values)
+                   => (lambda (s)
+                        (append (loop null accum)
+                                (cons s (loop (cdr l) null))))]
+                  [else
+                   (loop (cdr l) (cons (car l) accum))]))]))
+       ,@(get-nested)
+       ,@(let ([l (hash-ref ht 'stx-data #f)])
+           (if l
+               `((begin-for-all
+                   (define (.get-syntax-literal! pos)
+                     ....
+                     ,@(decompile-data-linklet l)
+                     ....)))
+               null))))
+  the-mod)
 
 (define (decompile-single-top b)
   (define forms (let ([l (hash-ref (linkl-bundle-table b) 0 #f)])

pkgs/compiler-lib/compiler/private/deserialize.rkt

@@ -83,6 +83,15 @@
               (define-values (a a-rest) (loop r))
               (values (cons a accum) a-rest)))
           (values (reverse rev) rest)]
+         [(#:vector)
+          (define-values (rev rest)
+            (for/fold ([accum '()] [r (cddr r)]) ([i (in-range (cadr r))])
+              (define-values (a a-rest) (loop r))
+              (values (cons a accum) a-rest)))
+          (values (vector->immutable-vector (list->vector (reverse rev))) rest)]
+         [(#:box)
+          (define-values (v rest) (loop (cdr r)))
+          (values (box-immutable v) rest)]
          [(#:mpi)
           (values (vector-ref mpis (cadr r)) (cddr r))]
          [(#:hash #:hashalw #:hasheq #:hasheqv #:hasheqv/phase+space)
@@ -119,7 +128,9 @@
                  (boolean? i)
                  (and (pair? i)
                       (phase? (car i))
-                      (symbol? (cdr i))))
+                      (symbol? (cdr i)))
+                 (and (list? i)
+                      (andmap phase? i)))
              (values i (cdr r))]
             [else
              (error 'deserialize "unsupported instruction: ~s" i)])])])))
@@ -178,6 +189,7 @@
        (values (instance-variable-value data-i '.mpi-vector)
                (instance-variable-value decl-i 'requires)
                (instance-variable-value decl-i 'recur-requires)
+               (instance-variable-value decl-i 'flattened-requires)
                (instance-variable-value decl-i 'provides)
                (instance-variable-value decl-i 'phase-to-link-modules))]
       [link-l
@@ -187,6 +199,7 @@
        (values (instance-variable-value link-i '.mpi-vector)
                '()
                '()
+               #f
                '#hasheqv()
                (instance-variable-value link-i 'phase-to-link-modules))]
       [else (values '#() '() '() '#hasheqv() '#hasheqv())])))

pkgs/racket-doc/scribblings/reference/syntax.scrbl

@@ -410,6 +410,7 @@ Legal only in a @tech{module begin context}, and handled by the
          ([declaration-keyword #:cross-phase-persistent
                                #:empty-namespace
                                #:require=define
+                               #:flatten-requires
                                #:unsafe
                                (code:line #:realm identifier)])]{
 
@@ -435,6 +436,16 @@ module:
        binding. This declaration does not affect shadowing of a
        module's initial imports (i.e., the module's language).}
 
+@item{@indexed-racket[#:flatten-requires] --- declares the performance
+       hint that a compiled form of the module should gather
+       transitive imports into a single, flattened list, which can
+       improve performance when the module is @tech{instantiate}d or
+       when it is attached via @racket[namespace-attach-module] or
+       @racket[namespace-attach-module-declaration]. Flattening
+       imports can be counterproductive, however, when it is applied
+       to multiple modules that are both use by another and that have
+       overlapping transitive-import subtrees.}
+
 @item{@indexed-racket[#:unsafe] --- declares that the module can be
        compiled without checks that could trigger
        @racket[exn:fail:contract], and the resulting behavior is
@@ -465,7 +476,8 @@ context} or a @tech{module-begin context}. Each
 @history[#:changed "6.3" @elem{Added @racket[#:empty-namespace].}
          #:changed "7.9.0.5" @elem{Added @racket[#:unsafe].}
          #:changed "8.4.0.2" @elem{Added @racket[#:realm].}
-         #:changed "8.6.0.9" @elem{Added @racket[#:require=define].}]}
+         #:changed "8.6.0.9" @elem{Added @racket[#:require=define].}
+         #:changed "8.13.0.4" @elem{Added @racket[#:flatten-requires].}]}
 
 
 @;------------------------------------------------------------------------

pkgs/racket-test-core/tests/racket/module.rktl

@@ -300,6 +300,35 @@
     (test '(mma ma pma a) values l)
     (void)))
 
+(module provides-variable-m-at-phase-1 racket/base
+  (require (for-syntax racket/base))
+  (provide (for-syntax m))
+  (define-for-syntax m 10))
+
+(module uses-m-at-phase-1-shifted-to-0 racket/base
+  (require (for-template 'provides-variable-m-at-phase-1))
+  (provide n)
+  (define n #'m))
+
+(err/rt-test/once
+ (let ([orig (current-namespace)])
+   (parameterize ([current-namespace (make-base-namespace)])
+     (namespace-attach-module orig ''uses-m-at-phase-1-shifted-to-0)))
+ exn:fail?
+ #rx"module not instantiated .in the source namespace.")
+
+(test #t syntax? (dynamic-require ''uses-m-at-phase-1-shifted-to-0 'n))
+
+(test 10
+      'eval-in-attached
+      (let ([orig (current-namespace)])
+        (parameterize ([current-namespace (make-base-namespace)])
+          (namespace-attach-module orig ''uses-m-at-phase-1-shifted-to-0)
+          (define stx (dynamic-require ''uses-m-at-phase-1-shifted-to-0 'n))
+          ;; Using `eval` works only when `provides-variable-m-at-phase-1`
+          ;; is correctly attached as instantiated in this namespace
+          (eval stx))))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Check redundant import and re-provide
 

pkgs/racket-test-core/tests/racket/number.rktl

@@ -3699,7 +3699,9 @@
     (check-random-pairs check-shift-plus-bits-to-even)))
 
 (check-conversion max-53-bit-number)
-(for ([i 100])
+(for ([i (if (eq? (system-type 'gc) 'cgc)
+             10
+             100)])
   (check-conversion
    ;; Random 53-bit number:
    (+ (arithmetic-shift 1 52)

pkgs/racket-test-core/tests/racket/optimize.rktl

@@ -78,13 +78,13 @@
         (error 'compile/optimize "compiled content does not have expected shape: ~s"
                s-exp))
 
-      (define-values (mpi-vector requires recur-requires provides phase-to-link-modules)
-          (deserialize-requires-and-provides bundle))
+      (define-values (mpi-vector requires recur-requires flattened-requires provides phase-to-link-modules)
+        (deserialize-requires-and-provides bundle))
       (define link-modules (hash-ref phase-to-link-modules 0 '()))
 
       ;; Support cross-module inlining
       (define (bundle->keys+uses bundle)
-        (define-values (mpi-vector requires recur-requires provides phase-to-link-modules)
+        (define-values (mpi-vector requires recur-requires flattened-requires provides phase-to-link-modules)
           (deserialize-requires-and-provides bundle))
         (define link-modules (hash-ref phase-to-link-modules 0 '()))
         (define keys (for/list ([r (in-list link-modules)])

pkgs/zo-lib/compiler/zo-structs.rkt

@@ -73,7 +73,7 @@
 
 (define-form-struct (linkl-directory zo) ([table (hash/c (listof symbol?) linkl-bundle?)]))
 (define-form-struct (linkl-bundle zo)    ([table (hash/c (or/c symbol? fixnum?)
-                                                         any/c)])) ; can be anythingv, but especially a linklet
+                                                         any/c)])) ; can be anything, but especially a linklet
 
 (define-form-struct (lam expr) ([name (or/c symbol? vector? empty?)]
                                 [flags (listof (or/c 'preserves-marks 'is-method 'single-result

racket/collects/racket/base.rkt

@@ -1,4 +1,6 @@
 (module base "private/base.rkt"
+  (#%declare #:flatten-requires)
+
   (provide (all-from-out "private/base.rkt"))
 
   (module reader syntax/module-reader