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).
This commit is contained in:
Matthew Flatt
parent
693ff33bfc
commit
a73dc50224
|
|
@ -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
|
||||
(collect-info-ht (resolve-info-ci ri))))))
|
||||
(serialize (cons root ht))))
|
||||
|
||||
(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)))
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -32,10 +32,11 @@
|
|||
|
||||
(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 info (doc ; doc structure above
|
||||
provides ; provides
|
||||
undef ; unresolved requires
|
||||
(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
|
||||
providess ; list of list of provide
|
||||
undef ; unresolved requires
|
||||
searches
|
||||
deps
|
||||
known-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
|
||||
(with-my-namespace
|
||||
(lambda ()
|
||||
(deserialize v))))
|
||||
(for/list ([v-out v-outs]) ; providess
|
||||
(let ([v (list-ref v-out 2)])
|
||||
(with-my-namespace
|
||||
(lambda ()
|
||||
(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
|
||||
(info-out-time . >= . src-time)
|
||||
(with-handlers ([exn:fail? (lambda (exn) #f)])
|
||||
(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)))]
|
||||
[sci (send renderer serialize-info ri)]
|
||||
[defs (send renderer get-defined ci)]
|
||||
[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))))]
|
||||
[scis (send renderer serialize-infos ri (add1 (doc-out-count doc)) v)]
|
||||
[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)
|
||||
(not (equal? (list vers (doc-flags doc))
|
||||
(car out-v)))
|
||||
(not (serialized=? sci (cadr out-v)))
|
||||
(not (equal? (any-order defs) (any-order (deserialize (caddr out-v)))))
|
||||
(or (not out-vs)
|
||||
(not (for/and ([out-v out-vs])
|
||||
(equal? (list vers (doc-flags doc))
|
||||
(car 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")))
|
||||
[(list (list in-version undef deps-rel searches dep-docs) (list out-version sci provides))
|
||||
(unless (and (equal? in-version (list vers (doc-flags doc)))
|
||||
(equal? out-version (list vers (doc-flags doc))))
|
||||
(match (list (load-sxref (sxref-path latex-dest doc "in.sxref"))
|
||||
(for/list ([i (add1 (doc-out-count doc))])
|
||||
(load-sxref (sxref-path latex-dest doc (format "out~a.sxref" i)))))
|
||||
[(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
|
||||
(deserialize provides)))]))
|
||||
scis
|
||||
(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)
|
||||
(cadr (load-sxref (sxref-path latex-dest doc "out.sxref"))))
|
||||
(define (load-doc-scis doc)
|
||||
(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)
|
||||
(info-provides info))
|
||||
(load-doc-scis doc)
|
||||
(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])
|
||||
(send renderer deserialize-info (load-doc-sci dep-doc) ci))))
|
||||
(for* ([dep-doc ff-dep-docs]
|
||||
[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))]
|
||||
[defs (render-time "defined" (send renderer get-defined ci))]
|
||||
[scis (render-time "serialize" (send renderer serialize-infos ri (add1 (doc-out-count doc)) v))]
|
||||
[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))
|
||||
(not (equal? (any-order defs) (any-order ff-provides))))]
|
||||
[out-delta? (or (not (for/and ([sci scis]
|
||||
[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)
|
||||
(write- latex-dest vers doc "out.sxref"
|
||||
(define (write-out latex-dest vers doc scis providess db-file)
|
||||
(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)
|
||||
(write-out latex-dest (info-vers info) (info-doc info) sci (info-provides info) db-file))
|
||||
(define (write-out/info latex-dest info scis 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"
|
||||
|
|
|
|||
|
|
@ -20,24 +20,34 @@
|
|||
(if d (list d) null))])
|
||||
(for/hash ([k (in-list (find-relevant-directories '(scribblings) 'no-planet))])
|
||||
(values k #t))))
|
||||
(for*/list ([dir (find-relevant-directories '(scribblings) 'all-available)]
|
||||
[d (let ([info-proc (get-info/full dir)])
|
||||
(if info-proc
|
||||
(info-proc 'scribblings)
|
||||
'()))])
|
||||
(unless (and (list? d) (pair? d))
|
||||
(error 'xref "bad scribblings entry: ~e" d))
|
||||
(let* ([len (length d)]
|
||||
[flags (if (len . >= . 2) (cadr d) '())]
|
||||
[name (if (len . >= . 4)
|
||||
(cadddr d)
|
||||
(path->string
|
||||
(path-replace-suffix (file-name-from-path (car d))
|
||||
#"")))])
|
||||
(and (not (and (len . >= . 3) (memq 'omit (caddr d))))
|
||||
(let* ([d (doc-path dir name flags (hash-ref main-dirs dir #f) 'false-if-missing)]
|
||||
[p (and d (build-path d "out.sxref"))])
|
||||
(and p (file-exists? p) p))))))
|
||||
(apply
|
||||
append
|
||||
(for*/list ([dir (find-relevant-directories '(scribblings) 'all-available)]
|
||||
[d (let ([info-proc (get-info/full dir)])
|
||||
(if info-proc
|
||||
(info-proc 'scribblings)
|
||||
'()))])
|
||||
(unless (and (list? d) (pair? d))
|
||||
(error 'xref "bad scribblings entry: ~e" d))
|
||||
(let* ([len (length d)]
|
||||
[flags (if (len . >= . 2) (cadr d) '())]
|
||||
[name (if (len . >= . 4)
|
||||
(cadddr d)
|
||||
(path->string
|
||||
(path-replace-suffix (file-name-from-path (car d))
|
||||
#"")))]
|
||||
[out-count (if (len . >= . 5)
|
||||
(list-ref d 4)
|
||||
1)])
|
||||
(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 ()
|
||||
|
|
|
|||
|
|
@ -4,13 +4,15 @@
|
|||
setup/dirs
|
||||
tests/eli-tester)
|
||||
|
||||
;; FIXME: need to look for out<i>.sxref files
|
||||
|
||||
(provide xref-tests)
|
||||
(module+ main (xref-tests))
|
||||
(define (xref-tests)
|
||||
(define sxref (build-path (find-doc-dir) "reference" "out.sxref"))
|
||||
(when (file-exists? sxref)
|
||||
(define xref
|
||||
(load-xref (list (λ() (cadr (call-with-input-file* sxref fasl->s-exp))))))
|
||||
(load-xref (list (λ () (cadr (call-with-input-file* sxref fasl->s-exp))))))
|
||||
(test (xref-binding->definition-tag
|
||||
xref (list '(lib "contract.rkt" "racket") '->) #f)
|
||||
=> '(form ((lib "racket/contract/base.rkt") ->)))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user