break cross-reference info for document into pieces

For example, the cross-reference information for the
Reference is now broken into about 16 pieces, so that
resolving a cross-reference into the Reference doesn't
require loading all cross-reference information for
the Reference.

Every document is split into two pieces, so that the title
of a document is roughly in its own piece. That way,
re-building the page of all installed documentation can be more
scalable (after some further changes).

collects/scribble/base-render.rkt

@@ -256,10 +256,49 @@
     (define/public (get-serialize-version)
       4)
 
+    (define/public (serialize-infos ri n d)
+      (if (= n 1)
+          (list (serialize-info ri))
+          (map (lambda (ht) (serialize-one-ht ri ht))
+               (partition-info (resolve-info-ci ri) n d))))
+
+    (define/private (partition-info all-ci n d)
+      ;; partition information in `all-ci' based on `d's:
+      (let ([prefix (part-tag-prefix d)]
+            [new-hts (for/list ([i (in-range n)])
+                       (make-hash))]
+            [covered (make-hash)])
+        ;; Fill in new-hts from parts:
+        (for ([sub-d (in-list (part-parts d))]
+              [i (in-naturals)])
+          (define ht (list-ref new-hts (min (add1 i) (sub1 n))))
+          (define cdi (hash-ref (collect-info-parts all-ci) sub-d #f))
+          (define sub-prefix (part-tag-prefix sub-d))
+          (when cdi
+            (for ([(k v) (in-hash (collected-info-info cdi))])
+              (when (cadr k)
+                (define sub-k (if sub-prefix
+                                  (convert-key sub-prefix k)
+                                  k))
+                (define full-k (if prefix
+                                   (convert-key prefix sub-k)
+                                   sub-k))
+                (hash-set! ht full-k v)
+                (hash-set! covered full-k #t)))))
+        ;; Anything not covered in the new-hts must go in the main hts:
+        (let ([ht0 (car new-hts)])
+          (for ([(k v) (in-hash (collect-info-ht all-ci))])
+            (unless (hash-ref covered k #f)
+              (hash-set! ht0 k v))))
+        ;; Return hts:
+        new-hts))
+
     (define/public (serialize-info ri)
+      (serialize-one-ht ri (collect-info-ht (resolve-info-ci ri))))
+
+    (define/public (serialize-one-ht ri ht)
       (parameterize ([current-serialize-resolve-info ri])
-        (serialize (cons root
+        (serialize (cons root ht))))
-                         (collect-info-ht (resolve-info-ci ri))))))
 
     (define/public (deserialize-info v ci #:root [root-path #f])
       (let ([root+ht (deserialize v)]
@@ -272,6 +311,10 @@
     (define/public (get-defined ci)
       (hash-map (collect-info-ht ci) (lambda (k v) k)))
 
+    (define/public (get-defineds ci n d)
+      (for/list ([ht (partition-info ci n d)])
+        (hash-map ht (lambda (k v) k))))
+
     (define/public (get-external ri)
       (hash-map (resolve-info-undef ri) (lambda (k v) k)))
 

collects/scribblings/raco/setup.scrbl

@@ -154,7 +154,8 @@ Optional @filepath{info.rkt} fields trigger additional actions by
      [doc (list src-string)
           (list src-string flags)
           (list src-string flags category)
-          (list src-string flags category name-string)]
+          (list src-string flags category name-string)
+          (list src-string flags category name-string out-k)]
      [flags (list mode-symbol ...)]
      [category (list category-symbol)
                (list category-symbol sort-number)]
@@ -271,7 +272,13 @@ Optional @filepath{info.rkt} fields trigger additional actions by
    alphabetically. For a pair of manuals with sorting numbers
    @racket[_n] and @racket[_m], the groups for the manuals are
    separated by space if @racket[(truncate (/ _n 10))]and
-   @racket[(truncate (/ _m 10))] are different.}
+   @racket[(truncate (/ _m 10))] are different.
+
+   The @racket[_out-k] specification is a hint on whether to break the
+   document's cross-reference information into multiple parts, which
+   can reduce the time and memory use for resolving a cross-reference
+   into the document. It must be a positive, exact integer, and the
+   default is @racket[1].}
 
  @item{@racket[racket-launcher-names] : @racket[(listof string?)]
    --- @elemtag["racket-launcher-names"] A list of executable names

collects/scribblings/reference/info.rkt

@@ -1,3 +1,3 @@
 #lang setup/infotab
 
-(define scribblings '(("reference.scrbl" (multi-page) (racket-core -12))))
+(define scribblings '(("reference.scrbl" (multi-page) (racket-core -12) "reference" 16)))

collects/scribblings/scribble/renderer.scrbl

@@ -168,12 +168,25 @@ directory; normally, they should indicates a path within the
 @racket[_dest-dir] supplied on initialization of the @racket[render%]
 object.}
 
+
 @defmethod[(serialize-info [ri resolve-info?])
            any/c]{
 
 Serializes the collected info in @racket[ri].}
 
 
+@defmethod[(serialize-infos [ri resolve-info?] 
+                            [count exact-positive-integer?] 
+                            [doc part?])
+           list?]{
+
+Like @method[render<%> serialize-info], but produces @racket[count] results
+that together have the same information as produced by
+@method[render<%> serialize-info]. The structure of @racket[doc] is used to
+drive the partitioning (on the assumption that @racket[ri] is derived
+from @racket[doc]).}
+
+
 @defmethod[(deserialize-info [v any/c]
                              [ci collect-info?]
                              [#:root root-path (or/c path-string? false/c) #f])
@@ -193,6 +206,17 @@ Returns a list of tags that were defined within the documents
 represented by @racket[ci].}
 
 
+@defmethod[(get-defineds [ci collect-info?] 
+                         [count exact-positive-integer?] 
+                         [doc part?])
+           (listof (listof tag?))]{
+
+Analogous to @method[render<%> serialize-infos]: returns a list of
+tags for each of @racket[count] partitions of the result of
+@method[render<%> get-defined], using the structure of @racket[doc] to
+drive the partitioning.}
+
+
 @defmethod[(get-external [ri resolve-info?]) (listof tag?)]{
 
 Returns a list of tags that were referenced but not defined within the

collects/setup/scribble.rkt

@@ -32,9 +32,10 @@
 
 (define verbose (make-parameter #t))
 
-(define-serializable-struct doc (src-dir src-spec src-file dest-dir flags under-main? category) #:transparent)
+(define-serializable-struct doc (src-dir src-spec src-file dest-dir flags under-main? category out-count)
+  #:transparent)
 (define-serializable-struct info (doc       ; doc structure above
-                                  provides ; provides
+                                  providess ; list of list of provide
                                   undef     ; unresolved requires
                                   searches 
                                   deps 
@@ -79,7 +80,7 @@
     (memq sym '(main-doc main-doc-root user-doc-root user-doc multi-page
                          depends-all depends-all-main no-depend-on always-run)))
   (define (validate-scribblings-infos infos)
-    (define (validate path [flags '()] [cat '(library)] [name #f])
+    (define (validate path [flags '()] [cat '(library)] [name #f] [out-count 1])
       (and (string? path) (relative-path? path)
            (list? flags) (andmap scribblings-flag? flags)
            (or (not name) (and (path-string? name) (relative-path? name) name))
@@ -88,12 +89,14 @@
                 (symbol? (car cat))
                 (or (null? (cdr cat))
                     (real? (cadr cat))))
+           (and (exact-positive-integer? out-count))
            (list path flags cat
                  (or name (let-values ([(_1 name _2) (split-path path)])
-                            (path-replace-suffix name #""))))))
+                            (path-replace-suffix name #"")))
+                 out-count)))
     (and (list? infos)
          (let ([infos (map (lambda (i)
-                             (and (list? i) (<= 1 (length i) 4)
+                             (and (list? i) (<= 1 (length i) 5)
                                   (apply validate i)))
                            infos)])
            (and (not (memq #f infos)) infos))))
@@ -121,7 +124,8 @@
                                           (cdr spec))))
                              (simplify-path (build-path dir (car d)) #f)
                              (doc-path dir (cadddr d) flags under-main?)
-                             flags under-main? (caddr d))))
+                             flags under-main? (caddr d)
+                             (list-ref d 4))))
                s)
           (begin (setup-printf
                   "WARNING"
@@ -192,7 +196,8 @@
           [src->info (make-hash)])
       ;; Collect definitions
       (for* ([info infos]
-             [k (info-provides info)])
+             [ks (info-providess info)]
+             [k ks])
         (let ([prev (hash-ref ht k #f)])
           (when (and first? prev)
             (setup-printf "WARNING" "duplicate tag: ~s" k)
@@ -329,9 +334,9 @@
           (define (update-info info response)
             (match response 
               [#f (set-info-failed?! info #t)]
-              [(list in-delta? out-delta? defs undef)
+              [(list in-delta? out-delta? defss undef)
                (set-info-rendered?! info #t)
-               (set-info-provides! info defs)
+               (set-info-providess! info defss)
                (set-info-undef! info undef)
                (when out-delta?
                  (set-info-out-time! info (/ (current-inexact-milliseconds) 1000)))
@@ -522,7 +527,8 @@
 (define ((get-doc-info only-dirs latex-dest auto-main? auto-user?
                        with-record-error setup-printf workerid)
          doc)
-  (let* ([info-out-file (sxref-path latex-dest doc "out.sxref")]
+  (let* ([info-out-files (for/list ([i (add1 (doc-out-count doc))])
+                           (sxref-path latex-dest doc (format "out~a.sxref" i)))]
          [info-in-file  (sxref-path latex-dest doc "in.sxref")]
          [db-file (find-db-file doc)]
          [stamp-file  (sxref-path latex-dest doc "stamp.sxref")]
@@ -556,7 +562,10 @@
                          stamp-time stamp-data 2
                          get-file-sha1))]
          [my-time (file-or-directory-modify-seconds out-file #f (lambda () -inf.0))]
-         [info-out-time (file-or-directory-modify-seconds info-out-file #f (lambda () #f))]
+         [info-out-time (for/fold ([t +inf.0]) ([info-out-file info-out-files])
+                          (and t
+                               (let ([t2 (file-or-directory-modify-seconds info-out-file #f (lambda () #f))])
+                                 (and t2 (min t t2)))))]
          [info-in-time (file-or-directory-modify-seconds info-in-file #f (lambda () #f))]
          [info-time (min (or info-out-time -inf.0) (or info-in-time -inf.0))]
          [vers (send renderer get-serialize-version)]
@@ -596,23 +605,25 @@
          (with-handlers ([exn:fail? (lambda (exn)
                                       (log-error (format "get-doc-info error: ~a"
                                                          (exn-message exn)))
-                                      (delete-file info-out-file)
+                                      (for-each delete-file info-out-files)
                                       (delete-file info-in-file)
                                       ((get-doc-info only-dirs latex-dest auto-main?
                                                      auto-user? with-record-error
                                                      setup-printf workerid)
                                        doc))])
            (let* ([v-in  (load-sxref info-in-file)]
-                  [v-out (load-sxref info-out-file)])
+                  [v-outs (map load-sxref info-out-files)])
              (unless (and (equal? (car v-in) (list vers (doc-flags doc)))
-                          (equal? (car v-out) (list vers (doc-flags doc))))
+                          (for/and ([v-out v-outs])
+                            (equal? (car v-out) (list vers (doc-flags doc)))))
                (error "old info has wrong version or flags"))
              (make-info
               doc
-              (let ([v (list-ref v-out 2)]) ; provides
+              (for/list ([v-out v-outs])  ; providess
+                (let ([v (list-ref v-out 2)])
                   (with-my-namespace
                    (lambda ()
-                   (deserialize v))))
+                     (deserialize v)))))
               (let ([v (list-ref v-in 1)])  ; undef
                 (with-my-namespace
                  (lambda ()
@@ -642,30 +653,36 @@
                         [fp (send renderer traverse (list v) (list dest-dir))]
                         [ci (send renderer collect (list v) (list dest-dir) fp)]
                         [ri (send renderer resolve (list v) (list dest-dir) ci)]
-                        [out-v (and info-out-time
+                        [out-vs (and info-out-time
                                      (info-out-time . >= . src-time)
                                      (with-handlers ([exn:fail? (lambda (exn) #f)])
+                                       (for/list ([info-out-file info-out-files])
                                          (let ([v (load-sxref info-out-file)])
                                            (unless (equal? (car v) (list vers (doc-flags doc)))
                                              (error "old info has wrong version or flags"))
-                                        v)))]
+                                           v))))]
-                        [sci (send renderer serialize-info ri)]
+                        [scis (send renderer serialize-infos ri (add1 (doc-out-count doc)) v)]
-                        [defs (send renderer get-defined ci)]
+                        [defss (send renderer get-defineds ci (add1 (doc-out-count doc)) v)]
                         [undef (send renderer get-external ri)]
                         [searches (resolve-info-searches ri)]
                         [need-out-write?
-                         (or (not out-v)
+                         (or (not out-vs)
-                             (not (equal? (list vers (doc-flags doc))
+                             (not (for/and ([out-v out-vs])
-                                          (car out-v)))
+                                    (equal? (list vers (doc-flags doc))
-                             (not (serialized=? sci (cadr out-v)))
+                                            (car out-v))))
-                             (not (equal? (any-order defs) (any-order (deserialize (caddr out-v)))))
+                             (not (for/and ([sci scis]
+                                            [out-v out-vs])
+                                    (serialized=? sci (cadr out-v))))
+                             (not (for/and ([defs defss]
+                                            [out-v out-vs])
+                                    (equal? (any-order defs) (any-order (deserialize (caddr out-v))))))
                              (info-out-time . > . (current-seconds)))])
                    (when (and (verbose) need-out-write?)
                      (eprintf " [New out ~a]\n" (doc-src-file doc)))
                    (gc-point)
                    (let ([info
                           (make-info doc
-                                     defs     ; provides
+                                     defss  ; providess
                                      undef
                                      searches
                                      null ; no deps, yet
@@ -682,7 +699,7 @@
                                      #f
                                      #f)])
                      (when need-out-write?
-                       (render-time "xref-out" (write-out/info latex-dest info sci db-file))
+                       (render-time "xref-out" (write-out/info latex-dest info scis db-file))
                        (set-info-need-out-write?! info #f))
                      (when (info-need-in-write? info)
                        (render-time "xref-in" (write-in/info latex-dest info))
@@ -728,18 +745,23 @@
   (collect-garbage) (collect-garbage) (printf "post ~a ~s\n" what (current-memory-use)))))
 
 (define (load-sxrefs latex-dest doc vers)
-  (match (list (load-sxref (sxref-path latex-dest doc "in.sxref")) (load-sxref (sxref-path latex-dest doc "out.sxref")))
+  (match (list (load-sxref (sxref-path latex-dest doc "in.sxref"))
-    [(list (list in-version undef deps-rel searches dep-docs) (list out-version sci provides))
+               (for/list ([i (add1 (doc-out-count doc))])
-     (unless (and (equal? in-version  (list vers (doc-flags doc)))
+                 (load-sxref (sxref-path latex-dest doc (format "out~a.sxref" i)))))
-                  (equal? out-version (list vers (doc-flags doc))))
+    [(list (list in-version undef deps-rel searches dep-docs) 
+           (list (list out-versions scis providess) ...))
+     (define expected (list vers (doc-flags doc)))
+     (unless (and (equal? in-version  expected)
+                  (for/and ([out-version out-versions])
+                    (equal? out-version expected)))
        (error "old info has wrong version or flags"))
      (with-my-namespace*
       (values (deserialize undef) 
               deps-rel
               (deserialize searches)
               (map rel-doc->doc (deserialize dep-docs))
-              sci
+              scis
-              (deserialize provides)))]))
+              (map deserialize providess)))]))
 
 (define (build-again! latex-dest info with-record-error)
   (define (cleanup-dest-dir doc)
@@ -753,22 +775,23 @@
                        (not (regexp-match? #"[.]sxref$"
                                            (path-element->bytes f)))))
               (delete-file (build-path dir f)))))))
-  (define (load-doc-sci doc)
+  (define (load-doc-scis doc)
-    (cadr (load-sxref (sxref-path latex-dest doc "out.sxref"))))
+    (map cadr (for/list ([i (add1 (doc-out-count doc))])
+                (load-sxref (sxref-path latex-dest doc (format "out~a.sxref" i))))))
   (define doc (if (info? info ) (info-doc info) info))
   (define renderer (make-renderer latex-dest doc))
   (with-record-error
    (doc-src-file doc)
    (lambda ()
      (define vers (send renderer get-serialize-version))
-     (define-values (ff-undef ff-deps-rel ff-searches ff-dep-docs ff-sci ff-provides)
+     (define-values (ff-undef ff-deps-rel ff-searches ff-dep-docs ff-scis ff-providess)
        (if (info? info)
            (values (info-undef info) 
                    (info-deps->rel-doc-src-file info)
                    (info-searches info)
                    (info-deps->doc info)
-                   (load-doc-sci doc)
+                   (load-doc-scis doc)
-                   (info-provides info))
+                   (info-providess info))
            (load-sxrefs latex-dest doc vers)))
      
      (parameterize ([current-directory (doc-src-dir doc)])
@@ -779,15 +802,20 @@
               [ri (begin 
                     (render-time "deserialize" 
                                  (with-my-namespace* 
-                                  (for ([dep-doc ff-dep-docs]) 
+                                  (for* ([dep-doc ff-dep-docs]
-                                    (send renderer deserialize-info (load-doc-sci dep-doc) ci))))
+                                         [sci (load-doc-scis dep-doc)])
+                                    (send renderer deserialize-info sci ci))))
                     (render-time "resolve" (send renderer resolve (list v) (list dest-dir) ci)))]
-              [sci (render-time "serialize" (send renderer serialize-info ri))]
+              [scis (render-time "serialize" (send renderer serialize-infos ri (add1 (doc-out-count doc)) v))]
-              [defs (render-time "defined" (send renderer get-defined ci))]
+              [defss (render-time "defined" (send renderer get-defineds ci (add1 (doc-out-count doc)) v))]
               [undef (render-time "undefined" (send renderer get-external ri))]
               [in-delta? (not (equal? (any-order undef) (any-order ff-undef)))]
-              [out-delta? (or (not (serialized=? sci ff-sci))
+              [out-delta? (or (not (for/and ([sci scis]
-                              (not (equal? (any-order defs) (any-order ff-provides))))]
+                                             [ff-sci ff-scis])
+                                     (serialized=? sci ff-sci)))
+                              (not (for/and ([defs defss]
+                                             [ff-provides ff-providess])
+                                     (equal? (any-order defs) (any-order ff-provides)))))]
               [db-file (find-db-file doc)])
          (when (verbose)
            (printf " [~a~afor ~a]\n"
@@ -800,7 +828,7 @@
          (when in-delta?
            (render-time "xref-in" (write-in latex-dest vers doc undef ff-deps-rel ff-searches ff-dep-docs)))
          (when out-delta?
-           (render-time "xref-out" (write-out latex-dest vers doc sci defs db-file)))
+           (render-time "xref-out" (write-out latex-dest vers doc scis defss db-file)))
 
          (cleanup-dest-dir doc)
          (render-time
@@ -810,7 +838,7 @@
            (lambda () (send renderer render (list v) (list dest-dir) ri))
            void))
          (gc-point)
-         (list in-delta? out-delta? defs undef))))
+         (list in-delta? out-delta? defss undef))))
    (lambda () #f)))
 
 (define (gc-point)
@@ -854,16 +882,19 @@
                          (lambda (out tmp-filename)
                            (write-bytes (s-exp->fasl (append (list (list vers (doc-flags doc))) data)) out)))))
 
-(define (write-out latex-dest vers doc sci provides db-file)
+(define (write-out latex-dest vers doc scis providess db-file)
-  (write- latex-dest vers doc "out.sxref" 
+  (for ([i (add1 (doc-out-count doc))]
+        [sci scis]
+        [provides providess])
+  (write- latex-dest vers doc (format "out~a.sxref" i)
           (list sci
                 (serialize provides))
           (lambda (filename)
             (unless latex-dest
-              (doc-db-record-provides db-file provides filename)))))
+              (doc-db-record-provides db-file provides filename))))))
 
-(define (write-out/info latex-dest info sci db-file)
+(define (write-out/info latex-dest info scis db-file)
-  (write-out latex-dest (info-vers info) (info-doc info) sci (info-provides info) db-file))
+  (write-out latex-dest (info-vers info) (info-doc info) scis (info-providess info) db-file))
 
 (define (write-in latex-dest vers doc undef rels searches dep-docs)
   (write- latex-dest vers doc "in.sxref" 

collects/setup/xref.rkt

@@ -20,6 +20,8 @@
                       (if d (list d) null))])
       (for/hash ([k (in-list (find-relevant-directories '(scribblings) 'no-planet))])
         (values k #t))))
+  (apply
+   append
    (for*/list ([dir (find-relevant-directories '(scribblings) 'all-available)]
                [d (let ([info-proc (get-info/full dir)])
                     (if info-proc
@@ -33,11 +35,19 @@
                        (cadddr d)
                        (path->string
                         (path-replace-suffix (file-name-from-path (car d))
-                                          #"")))])
+                                             #"")))]
-      (and (not (and (len . >= . 3) (memq 'omit (caddr d))))
+            [out-count (if (len . >= . 5)
-           (let* ([d (doc-path dir name flags (hash-ref main-dirs dir #f) 'false-if-missing)]
+                           (list-ref d 4)
-                  [p (and d (build-path d "out.sxref"))])
+                           1)])
-             (and p (file-exists? p) p))))))
+       (if (not (and (len . >= . 3) (memq 'omit (caddr d))))
+           (let ([d (doc-path dir name flags (hash-ref main-dirs dir #f) 'false-if-missing)])
+             (if d
+                 (for*/list ([i (in-range (add1 out-count))]
+                             [p (in-value (build-path d (format "out~a.sxref" i)))]
+                             #:when (file-exists? p))
+                   p)
+                 null))
+           null)))))
 
 (define (dest->source dest)
   (lambda ()

collects/tests/scribble/xref.rkt

@@ -4,6 +4,8 @@
          setup/dirs
          tests/eli-tester)
 
+;; FIXME: need to look for out<i>.sxref files
+
 (provide xref-tests)
 (module+ main (xref-tests))
 (define (xref-tests)