commit 280f5e966a8957a8891baa3ff6927cadc6e1236b
parent 8193c3e1ecce30e4ad3477edcb491eb4c9c41df6
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 20 Nov 2012 14:41:06 -0700
raco setup: build database mapping doc tags to "out.sxref"s
The `xref' produced by `setup/xref' uses the database to delay
loading "out.sxref"s, which cuts 64-bit DrRacket's initial
footprint by around 50MB (i.e., about 20%).
original commit: 8c1b5db81553b54b35e753441efd0465426707a3
Diffstat:
7 files changed, 65 insertions(+), 16 deletions(-)
diff --git a/collects/scribble/base-render.rkt b/collects/scribble/base-render.rkt
@@ -288,7 +288,11 @@
(define/public (transfer-info ci src-ci)
(let ([in-ht (collect-info-ext-ht ci)])
(for ([(k v) (collect-info-ext-ht src-ci)])
- (hash-set! in-ht k v))))
+ (hash-set! in-ht k v)))
+ (set-demand-chain-demands!
+ (collect-info-ext-demand ci)
+ (cons (collect-info-ext-demand src-ci)
+ (demand-chain-demands (collect-info-ext-demand ci)))))
;; ----------------------------------------
;; document-order traversal
@@ -386,10 +390,11 @@
;; ----------------------------------------
;; global-info collection
- (define/public (collect ds fns fp)
+ (define/public (collect ds fns fp [demand (lambda (key ci) #f)])
(let ([ci (make-collect-info fp
(make-hash)
(make-hash)
+ (make-demand-chain (list demand))
(make-hasheq)
(make-hasheq)
null
@@ -407,6 +412,7 @@
(collect-info-fp ci)
(make-hash)
(collect-info-ext-ht ci)
+ (collect-info-ext-demand ci)
(collect-info-parts ci)
(collect-info-tags ci)
(if (part-tag-prefix d)
@@ -911,3 +917,12 @@
;; ----------------------------------------
(super-new)))
+
+
+;; ----------------------------------------
+
+(define-struct demand-chain ([demands #:mutable])
+ #:property prop:procedure (lambda (self key ci)
+ (for/or ([demand (in-list (demand-chain-demands self))])
+ (demand key ci))))
+
diff --git a/collects/scribble/core.rkt b/collects/scribble/core.rkt
@@ -6,7 +6,7 @@
;; ----------------------------------------
-(define-struct collect-info (fp ht ext-ht parts tags gen-prefix relatives parents) #:transparent)
+(define-struct collect-info (fp ht ext-ht ext-demand parts tags gen-prefix relatives parents) #:transparent)
(define-struct resolve-info (ci delays undef searches) #:transparent)
(define (part-collected-info part ri)
@@ -34,8 +34,14 @@
(collected-info-parent (part-collected-info part ri))
ri key)]
[else
- (values (hash-ref (collect-info-ext-ht (resolve-info-ci ri)) key #f)
- #t)]))))
+ (define ci (resolve-info-ci ri))
+ (define (try-ext)
+ (hash-ref (collect-info-ext-ht ci) key #f))
+ (values
+ (or (try-ext)
+ (and ((collect-info-ext-demand ci) key ci)
+ (try-ext)))
+ #t)]))))
(define (resolve-get/ext? part ri key)
(resolve-get/ext?* part ri key #f))
diff --git a/collects/scribble/html-render.rkt b/collects/scribble/html-render.rkt
@@ -1483,11 +1483,12 @@
(define/override (include-navigation?) #t)
- (define/override (collect ds fns fp)
+ (define/override (collect ds fns fp [demand (lambda (key ci) #f)])
(super collect
ds
(map (lambda (fn) (build-path fn "index.html")) fns)
- fp))
+ fp
+ demand))
(define/override (current-part-whole-page? d)
(collecting-whole-page))
diff --git a/collects/scribble/xref.rkt b/collects/scribble/xref.rkt
@@ -34,16 +34,23 @@
(define-namespace-anchor here)
(define (load-xref sources
+ #:demand-source [demand-source (lambda (key) #f)]
#:render% [render% (html:render-mixin render%)]
#:root [root-path #f])
(let* ([renderer (new render% [dest-dir (find-system-path 'temp-dir)])]
[fp (send renderer traverse null null)]
- [ci (send renderer collect null null fp)])
+ [load-source (lambda (src ci)
+ (parameterize ([current-namespace
+ (namespace-anchor->empty-namespace here)])
+ (let ([v (src)])
+ (when v (send renderer deserialize-info v ci #:root root-path)))))]
+ [ci (send renderer collect null null fp
+ (lambda (key ci)
+ (define src (demand-source key))
+ (and src
+ (load-source src ci))))])
(for ([src sources])
- (parameterize ([current-namespace
- (namespace-anchor->empty-namespace here)])
- (let ([v (src)])
- (when v (send renderer deserialize-info v ci #:root root-path)))))
+ (load-source src ci))
(make-xrefs renderer (send renderer resolve null null ci))))
;; ----------------------------------------
diff --git a/collects/scribblings/scribble/core.scrbl b/collects/scribblings/scribble/core.scrbl
@@ -1193,7 +1193,9 @@ Returns the width in characters of the given @tech{content}.
Returns the width in characters of the given @tech{block}.}
-@defstruct[collect-info ([ht any/c] [ext-ht any/c] [parts any/c]
+@defstruct[collect-info ([ht any/c] [ext-ht any/c]
+ [ext-demand (tag? collect-info? . -> . any/c)]
+ [parts any/c]
[tags any/c] [gen-prefix any/c]
[relatives any/c]
[parents (listof part?)])]{
diff --git a/collects/scribblings/scribble/renderer.scrbl b/collects/scribblings/scribble/renderer.scrbl
@@ -127,12 +127,22 @@ information on the @racket[dests] argument.}
@defmethod[(collect [srcs (listof part?)]
[dests (listof path-string?)]
- [fp (and/c hash? immutable?)])
+ [fp (and/c hash? immutable?)]
+ [demand (tag? collect-info? . -> . any/c) (lambda (_tag _ci) #f)])
collect-info?]{
Performs the @techlink{collect pass}. See @method[render<%> render] for
-information on the @racket[dests] argument. The @racket[fp] argument
-is a result from the @method[render<%> traverse] method.}
+information on the @racket[dests] arguments. The @racket[fp] argument
+is a result from the @method[render<%> traverse] method.
+
+The @racket[demand] argument supplies external tag mappings on demand.
+When the @racket[collect-info] result is later used to find a mapping
+for a tag and no mapping is already available, @racket[demand] is
+called with the tag and the @racket[collect-info]. The @racket[demand]
+function returns true to indicate when it adds information to the
+@racket[collect-info] so that the lookup should be tried again; the
+@racket[demand] function should return @racket[#f] if it does not
+extend @racket[collect-info].}
@defmethod[(resolve [srcs (listof part?)]
[dests (listof path-string?)]
diff --git a/collects/scribblings/scribble/xref.scrbl b/collects/scribblings/scribble/xref.scrbl
@@ -20,6 +20,9 @@ by @racket[load-xref], @racket[#f] otherwise.}
@defproc[(load-xref [sources (listof (-> any/c))]
+ [#:demand-source demand-source
+ (tag? -> (or/c (-> any/c) #f))
+ (lambda (_tag) #f)]
[#:render% using-render% (implementation?/c render<%>)
(render-mixin render%)]
[#:root root-path (or/c path-string? false/c) #f])
@@ -30,6 +33,11 @@ produce a serialized information obtained from @xmethod[render<%>
serialize-info]. If a @racket[sources] element produces @racket[#f],
its result is ignored.
+The @racket[demand-source] function can effectively add a new source
+to @racket[sources] in response to a search for information on the
+given tag. The @racket[demand-source] function returns @racket[#f]
+to indicate that no new sources satisfy the given tag.
+
Since the format of serialized information is specific to a rendering
class, the optional @racket[using-render%] argument accepts the
relevant class. It defaults to HTML rendering, partly because