add fix-point finding traverse pass to Scribble

original commit: 8b7c8d08bdaeed5f0ec42fc1a4855ad19e7354b2
This commit is contained in:
Matthew Flatt 2010-05-21 18:43:43 -06:00
parent b13796a0db
commit f15af6e90b
7 changed files with 382 additions and 54 deletions

View File

@ -106,6 +106,8 @@
[(delayed-block? p)
(let ([v ((delayed-block-resolve p) this d ri)])
(extract-block-style-files v d ri ht pred extract))]
[(traverse-block? p)
(extract-block-style-files (traverse-block-block p ri) d ri ht pred extract)]
[else
(extract-style-style-files (paragraph-style p) ht pred extract)
(extract-content-style-files (paragraph-content p) d ri ht pred extract)]))
@ -125,6 +127,8 @@
(extract-content-style-files e d ri ht pred extract))]
[(delayed-element? e)
(extract-content-style-files (delayed-element-content e ri) d ri ht pred extract)]
[(traverse-element? e)
(extract-content-style-files (traverse-element-content e ri) d ri ht pred extract)]
[(part-relative-element? e)
(extract-content-style-files (part-relative-element-content e ri) d ri ht pred extract)]))
@ -229,11 +233,98 @@
(for ([(k v) (collect-info-ext-ht src-ci)])
(hash-set! in-ht k v))))
;; ----------------------------------------
;; document-order traversal
(define/public (traverse ds fns)
(let loop ([fp #hasheq()])
(let ([fp2 (start-traverse ds fns fp)])
(if (equal? fp fp2)
fp
(loop fp2)))))
(define/public (start-traverse ds fns fp)
(for/fold ([fp fp]) ([d (in-list ds)])
(traverse-part d fp)))
(define/public (traverse-part d fp)
(let* ([fp (if (part-title-content d)
(traverse-content (part-title-content d) fp)
fp)]
[fp (traverse-content (part-to-collect d) fp)]
[fp (traverse-flow (part-blocks d) fp)])
(for/fold ([fp fp]) ([p (in-list (part-parts d))])
(traverse-part p fp))))
(define/public (traverse-paragraph p fp)
(traverse-content (paragraph-content p) fp))
(define/public (traverse-flow p fp)
(for/fold ([fp fp]) ([p (in-list p)])
(traverse-block p fp)))
(define/public (traverse-block p fp)
(cond [(table? p) (traverse-table p fp)]
[(itemization? p) (traverse-itemization p fp)]
[(nested-flow? p) (traverse-nested-flow p fp)]
[(compound-paragraph? p) (traverse-compound-paragraph p fp)]
[(delayed-block? p) fp]
[(traverse-block? p) (traverse-force fp p
(traverse-block-traverse p)
(lambda (p fp) (traverse-block p fp)))]
[else (traverse-paragraph p fp)]))
(define/public (traverse-table i fp)
(for*/fold ([fp fp]) ([ds (in-list (table-blockss i))]
[d (in-list ds)])
(if (eq? d 'cont)
fp
(traverse-block d fp))))
(define/public (traverse-itemization i fp)
(for/fold ([fp fp]) ([d (in-list (itemization-blockss i))])
(traverse-flow d fp)))
(define/public (traverse-nested-flow i fp)
(for/fold ([fp fp]) ([d (in-list (nested-flow-blocks i))])
(traverse-block d fp)))
(define/public (traverse-compound-paragraph i fp)
(for/fold ([fp fp]) ([d (in-list (compound-paragraph-blocks i))])
(traverse-block d fp)))
(define/public (traverse-content i fp)
(cond
[(traverse-element? i) (traverse-force fp i (traverse-element-traverse i)
(lambda (i fp) (traverse-content i fp)))]
[(element? i) (traverse-content (element-content i) fp)]
[(list? i) (for/fold ([fp fp]) ([c (in-list i)])
(traverse-content c fp))]
[(multiarg-element? i)
(for/fold ([fp fp]) ([c (in-list (multiarg-element-contents i))])
(traverse-content c fp))]
[else fp]))
(define (traverse-force fp p proc again)
(let ([v (hash-ref fp p (lambda () proc))])
(if (procedure? v)
(let ([fp fp])
(let ([v2 (v (lambda (key default)
(hash-ref fp key default))
(lambda (key val)
(set! fp (hash-set fp key val))))])
(let ([fp (hash-set fp p v2)])
(if (procedure? v2)
fp
(again v2 fp)))))
fp)))
;; ----------------------------------------
;; global-info collection
(define/public (collect ds fns)
(let ([ci (make-collect-info (make-hash)
(define/public (collect ds fns fp)
(let ([ci (make-collect-info fp
(make-hash)
(make-hash)
(make-hasheq)
(make-hasheq)
@ -249,6 +340,7 @@
(define/public (collect-part d parent ci number)
(let ([p-ci (make-collect-info
(collect-info-fp ci)
(make-hash)
(collect-info-ext-ht ci)
(collect-info-parts ci)
@ -326,6 +418,7 @@
[(nested-flow? p) (collect-nested-flow p ci)]
[(compound-paragraph? p) (collect-compound-paragraph p ci)]
[(delayed-block? p) (void)]
[(traverse-block? p) (collect-block (traverse-block-block p ci) ci)]
[else (collect-paragraph p ci)]))
(define/public (collect-table i ci)
@ -409,6 +502,7 @@
(let ([v ((delayed-block-resolve p) this d ri)])
(hash-set! (resolve-info-delays ri) p v)
(resolve-block v d ri))]
[(traverse-block? p) (resolve-block (traverse-block-block p ri) d ri)]
[else (resolve-paragraph p d ri)]))
(define/public (resolve-table i d ri)
@ -437,6 +531,8 @@
(hash-set! (resolve-info-delays ri) i v)
v))
d ri)]
[(traverse-element? i)
(resolve-content (traverse-element-content i ri) d ri)]
[(list? i)
(for ([i (in-list i)])
(resolve-content i d ri))]
@ -539,6 +635,8 @@
[(compound-paragraph? p) (render-compound-paragraph p part ri starting-item?)]
[(delayed-block? p)
(render-block (delayed-block-blocks p ri) part ri starting-item?)]
[(traverse-block? p)
(render-block (traverse-block-block p ri) part ri starting-item?)]
[else (render-paragraph p part ri)]))
(define/public (render-auxiliary-table i part ri)
@ -575,6 +673,8 @@
(render-content (multiarg-element-contents i) part ri)]
[(delayed-element? i)
(render-content (delayed-element-content i ri) part ri)]
[(traverse-element? i)
(render-content (traverse-element-content i ri) part ri)]
[(part-relative-element? i)
(render-content (part-relative-element-content i ri) part ri)]
[else (render-other i part ri)]))
@ -683,7 +783,9 @@
(not (= base-len (sub1 (length number))))))
(positive? depth))
(apply append (map (lambda (p)
(generate-toc p ri base-len #f quiet (sub1 depth) prefixes))
(if (part-style? p 'toc-hidden)
null
(generate-toc p ri base-len #f quiet (sub1 depth) prefixes)))
(part-parts part)))
null)])
(if skip?

View File

@ -5,7 +5,7 @@
;; ----------------------------------------
(define-struct collect-info (ht ext-ht parts tags gen-prefix relatives parents))
(define-struct collect-info (fp ht ext-ht parts tags gen-prefix relatives parents))
(define-struct resolve-info (ci delays undef searches))
(define (part-collected-info part ri)
@ -92,7 +92,8 @@
(itemization? p)
(nested-flow? p)
(compound-paragraph? p)
(delayed-block? p)))
(delayed-block? p)
(traverse-block? p)))
(define content-symbols
#hasheq([nbsp . #t]
@ -115,6 +116,7 @@
(element? v)
(and (list? v) (andmap content? v))
(delayed-element? v)
(traverse-element? v)
(part-relative-element? v)
(multiarg-element? v)
(hash-ref content-symbols v #f)))
@ -188,6 +190,104 @@
;; ----------------------------------------
;; Traverse block has special serialization support:
(define-struct traverse-block (traverse)
#:property
prop:serializable
(make-serialize-info
(lambda (d)
(let ([ri (current-serialize-resolve-info)])
(unless ri
(error 'serialize-traverse-block
"current-serialize-resolve-info not set"))
(vector (traverse-block-block d ri))))
#'deserialize-traverse-block
#f
(or (current-load-relative-directory) (current-directory))))
(define block-traverse-procedure/c
(recursive-contract
((symbol? any/c . -> . any/c)
(symbol? any/c . -> . any)
. -> . (or/c block-traverse-procedure/c
block?))))
(provide block-traverse-procedure/c)
(provide/contract
(struct traverse-block ([traverse block-traverse-procedure/c])))
(provide deserialize-traverse-block)
(define deserialize-traverse-block
(make-deserialize-info values values))
(define (traverse-block-block b i)
(cond
[(collect-info? i)
(let ([p (hash-ref (collect-info-fp i) b #f)])
(if (block? p)
p
(error 'traverse-block-block
"no block computed for traverse-block: ~e"
b)))]
[(resolve-info? i)
(traverse-block-block b (resolve-info-ci i))]))
(provide/contract
[traverse-block-block (traverse-block?
(or/c resolve-info? collect-info?)
. -> . block?)])
;; ----------------------------------------
;; Traverse element has special serialization support:
(define-struct traverse-element (traverse)
#:property
prop:serializable
(make-serialize-info
(lambda (d)
(let ([ri (current-serialize-resolve-info)])
(unless ri
(error 'serialize-traverse-block
"current-serialize-resolve-info not set"))
(vector (traverse-element-content d ri))))
#'deserialize-traverse-element
#f
(or (current-load-relative-directory) (current-directory))))
(define element-traverse-procedure/c
(recursive-contract
((symbol? any/c . -> . any/c)
(symbol? any/c . -> . any)
. -> . (or/c element-traverse-procedure/c
content?))))
(provide/contract
(struct traverse-element ([traverse element-traverse-procedure/c])))
(provide deserialize-traverse-element)
(define deserialize-traverse-element
(make-deserialize-info values values))
(define (traverse-element-content e i)
(cond
[(collect-info? i)
(let ([c (hash-ref (collect-info-fp i) e #f)])
(if (content? c)
c
(error 'traverse-block-block
"no block computed for traverse-block: ~e"
e)))]
[(resolve-info? i)
(traverse-element-content e (resolve-info-ci i))]))
(provide element-traverse-procedure/c)
(provide/contract
[traverse-element-content (traverse-element?
(or/c resolve-info? collect-info?)
. -> . content?)])
;; ----------------------------------------
;; Delayed element has special serialization support:
(define-struct delayed-element (resolve sizer plain)
#:property
@ -203,9 +303,7 @@
(error 'serialize-delayed-element
"serialization failed (wrong resolve info? delayed element never rendered?); ~a"
(exn-message exn)))])
(vector
(let ([l (delayed-element-content d ri)])
l)))))
(vector (delayed-element-content d ri)))))
#'deserialize-delayed-element
#f
(or (current-load-relative-directory) (current-directory))))

View File

@ -366,7 +366,9 @@
'(nbsp))))
(define (toc-item->block t i)
(define-values (title num) (toc-item->title+num t #f))
(define children (part-parts t)) ; note: might be empty
(define children ; note: might be empty
(filter (lambda (p) (not (part-style? p 'toc-hidden)))
(part-parts t)))
(define id (format "tocview_~a" i))
(define last? (eq? t (last toc-chain)))
(define expand? (or (and last?
@ -435,6 +437,8 @@
(render-table e d ri #f)]
[(delayed-block? e)
(loop (delayed-block-blocks e ri))]
[(traverse-block? e)
(loop (traverse-block-block e ri))]
[(compound-paragraph? e)
(append-map loop (compound-paragraph-blocks e))]
[else null])))
@ -447,7 +451,8 @@
#f)
(define/private (render-onthispage-contents d ri top box-class sections-in-toc?)
(if (ormap (lambda (p) (part-whole-page? p ri))
(if (ormap (lambda (p) (or (part-whole-page? p ri)
(part-style? p 'toc-hidden)))
(part-parts d))
null
(let ([nearly-top? (lambda (d)
@ -467,7 +472,8 @@
(append-map block-targets (nested-flow-blocks e))]
[(compound-paragraph? e)
(append-map block-targets (compound-paragraph-blocks e))]
[(delayed-block? e) null]))
[(delayed-block? e) null]
[(traverse-block? e) (block-targets (traverse-block-block e ri))]))
(define (para-targets para)
(let loop ([a (paragraph-content para)])
(cond
@ -476,6 +482,7 @@
[(toc-element? a) (list a)]
[(element? a) (loop (element-content a))]
[(delayed-element? a) (loop (delayed-element-content a ri))]
[(traverse-element? a) (loop (traverse-element-content a ri))]
[(part-relative-element? a) (loop (part-relative-element-content a ri))]
[else null])))
(define (table-targets table)
@ -495,7 +502,10 @@
(if (nearly-top? d) null (list (cons d prefixes)))
;; get internal targets:
(map (lambda (v) (cons v prefixes)) (append-map block-targets (part-blocks d)))
(map (lambda (p) (if (part-whole-page? p ri) null (flatten p prefixes #f)))
(map (lambda (p) (if (or (part-whole-page? p ri)
(part-style? p 'toc-hidden))
null
(flatten p prefixes #f)))
(part-parts d)))))))
(define any-parts? (ormap (compose part? car) ps))
(if (null? ps)
@ -1225,7 +1235,6 @@
[(rang) '(8250)]
[else (list i)])]
[else
(error "bad")
(log-error (format "Unreocgnized element in content: ~e" i))
(list (format "~s" i))]))
@ -1301,8 +1310,11 @@
(define/override (include-navigation?) #t)
(define/override (collect ds fns)
(super collect ds (map (lambda (fn) (build-path fn "index.html")) fns)))
(define/override (collect ds fns fp)
(super collect
ds
(map (lambda (fn) (build-path fn "index.html")) fns)
fp))
(define/override (current-part-whole-page? d)
(collecting-whole-page))

View File

@ -161,24 +161,28 @@
null)
(define/private (no-noindent? p ri)
(if (delayed-block? p)
(no-noindent? (delayed-block-blocks p ri) ri)
(or
(memq 'never-indents
(style-properties
(cond
[(paragraph? p) (paragraph-style p)]
[(compound-paragraph? p) (compound-paragraph-style p)]
[(nested-flow? p) (nested-flow-style p)]
[(table? p) (table-style p)]
[(itemization? p) (itemization-style p)]
[else plain])))
(and (nested-flow? p)
(pair? (nested-flow-blocks p))
(no-noindent? (car (nested-flow-blocks p)) ri))
(and (compound-paragraph? p)
(pair? (compound-paragraph-blocks p))
(no-noindent? (car (compound-paragraph-blocks p)) ri)))))
(cond
[(delayed-block? p)
(no-noindent? (delayed-block-blocks p ri) ri)]
[(traverse-block? p)
(no-noindent? (traverse-block-block p ri) ri)]
[else
(or
(memq 'never-indents
(style-properties
(cond
[(paragraph? p) (paragraph-style p)]
[(compound-paragraph? p) (compound-paragraph-style p)]
[(nested-flow? p) (nested-flow-style p)]
[(table? p) (table-style p)]
[(itemization? p) (itemization-style p)]
[else plain])))
(and (nested-flow? p)
(pair? (nested-flow-blocks p))
(no-noindent? (car (nested-flow-blocks p)) ri))
(and (compound-paragraph? p)
(pair? (compound-paragraph-blocks p))
(no-noindent? (car (compound-paragraph-blocks p)) ri)))]))
(define/override (render-intrapara-block p part ri first? last? starting-item?)
(unless first?

View File

@ -117,7 +117,8 @@
(send renderer get-suffix))])
(if dir (build-path dir fn) fn))))
files)]
[info (send renderer collect docs fns)])
[fp (send renderer traverse docs fns)]
[info (send renderer collect docs fns fp)])
(for ([file (in-list (reverse (current-info-input-files)))])
(let ([s (with-input-from-file file read)])
(send renderer deserialize-info s info)))

View File

@ -9,20 +9,43 @@
@defmodule[scribble/core]
A document is represented as a @techlink{part}, as described in
@secref["parts"]. This representation is intended to
@secref["parts"]. This representation is intended to be
independent of its eventual rendering, and it is intended to be
immutable; rendering extensions and specific data in a document can
collude arbitrarily, however.
A document is processed in three passes. The first pass is the
@deftech{collect pass}, which globally collects information in the
document, such as targets for hyperlinking. The second pass is the
@deftech{resolve pass}, which matches hyperlink references with
targets and expands delayed elements (where the expansion should not
contribute new hyperlink targets). The final pass is the
@deftech{render pass}, which generates the resulting document. None
of the passes mutate the document, but instead collect information in
side @racket[collect-info] and @racket[resolve-info] tables.
A document is processed in four passes:
@itemlist[
@item{The @deftech{traverse pass} traverses the document content in
document order so that information from one part of a document
can be communicated to other parts of the same document. The
information is transmitted through a symbol-keyed mapping that
can be inspected and extended by @racket[traverse-element]s and
@racket[traverse-block]s in the document. The @tech{traverse
pass} iterates the traversal until it obtains a fixed point
(i.e., the mapping from one iteration is unchanged from the
previous iteration).}
@item{The @deftech{collect pass} globally collects information in the
document that can span documents that are built at separate
times, such as targets for hyperlinking.}
@item{The @deftech{resolve pass} matches hyperlink references
with targets and expands delayed elements (where the expansion
should not contribute new hyperlink targets).}
@item{The @deftech{render pass} generates the result document.}
]
None of the passes mutate the document representation. Instead, the
@tech{traverse pass}, @tech{collect pass}, and @tech{resolve pass}
accumulate information in a side hash table, @racket[collect-info]
table, and @racket[resolve-info] table. The @tech{collect pass} and
@tech{resolve pass} are effectively specialized version of
@tech{traverse pass} that work across separately built documents.
@; ------------------------------------------------------------------------
@ -38,8 +61,9 @@ A @deftech{part} is an instance of @racket[part]; among other things,
A @deftech{flow} is a list of @techlink{blocks}.
A @deftech{block} is either a @techlink{table}, an
@techlink{itemization}, a @techlink{nested flow}, a @techlink{paragraph},
a @techlink{compound paragraph}, or a @techlink{delayed block}.
@techlink{itemization}, a @techlink{nested flow}, a
@techlink{paragraph}, a @techlink{compound paragraph}, a
@techlink{traverse block}, or a @techlink{delayed block}.
@itemize[
@ -62,7 +86,7 @@ A @deftech{block} is either a @techlink{table}, an
@item{An @deftech{content} can be a string, one of a few
symbols, an instance of @racket[element] (possibly
@racket[link-element], etc.), a @racket[multiarg-element], a
@techlink{part-relative element}, a
a @techlink{traverse element}, @techlink{part-relative element}, a
@techlink{delayed element}, or a list of content.
@itemize[
@ -124,6 +148,12 @@ A @deftech{block} is either a @techlink{table}, an
processing to record information used by
later passes.}
@item{A @deftech{traverse element} is an instance
of @racket[traverse-element], which
ultimately produces content, but can
accumulate and inspect information in the
@tech{traverse pass}.}
@item{A @deftech{part-relative element} is an
instance of @racket[part-relative-element],
which has a procedure that is called in the
@ -153,6 +183,11 @@ A @deftech{block} is either a @techlink{table}, an
a single paragraph (e.g., no indentation after the first
block) instead of inset.}
@item{A @deftech{traverse block} is an instance of
@racket[traverse-block], which ultimately produces
another block, but can accumulate and inspect information
during the @tech{traverse pass}.}
@item{A @deftech{delayed block} is an instance of
@racket[delayed-block], which has a procedure that
is called in the @techlink{resolve pass} of document
@ -307,6 +342,9 @@ The recognized @tech{style properties} are as follows:
@item{@racket['hidden] --- The part title is not shown in rendered
HTML output.}
@item{@racket['toc-hidden] --- The part title is not shown in tables
of contents.}
@item{@racket['quiet] --- In HTML output and most other output modes,
hides entries for sub-parts of this part in a
@racket[table-of-contents] or @racket[local-table-of-contents]
@ -560,6 +598,19 @@ for Latex output (see @secref["extra-style"]). The following
]}
@defstruct[traverse-block ([traverse block-traverse-procedure/c])]{
Produces another block during the @tech{traverse pass}, eventually.
The @scheme[traverse] procedure is called with procedures to get and
set symbol-keyed information, and it should return either a
@tech{block} (which effectively takes the @racket[traverse-block]'s
place) or a procedure like @racket[traverse] to be called in the next
iteration of the @tech{traverse pass}.
All @racket[traverse-element] and @racket[traverse-block]s that have
not been replaced are forced in document order relative to each other
during an iteration of the @tech{traverse pass}.}
@defstruct[delayed-block ([resolve (any/c part? resolve-info? . -> . block?)])]{
The @racket[resolve] procedure is called during the @techlink{resolve
@ -745,6 +796,12 @@ it corresponds to a Latex command that accepts as many arguments (each
in curly braces) as elements of @racket[content].}
@defstruct[traverse-element ([traverse element-traverse-procedure/c])]{
Like @racket[traverse-block], but the @racket[traverse] procedure must
eventually produce @tech{content}, rather than a @tech{block}.}
@defstruct[delayed-element ([resolve (any/c part? resolve-info? . -> . list?)]
[sizer (-> any/c)]
[plain (-> any/c)])]{
@ -876,14 +933,16 @@ for each row in the table. This @tech{style property} is used only when a
@defproc[(block? [v any/c]) boolean?]{
Returns @racket[#t] if @racket[v] is a @racket[paragraph],
@racket[table], @racket[itemization], @racket[nested-flow], or
@racket[delayed-block], @racket[#f] otherwise.}
@racket[table], @racket[itemization], @racket[nested-flow],
@racket[traverse-block], or @racket[delayed-block], @racket[#f]
otherwise.}
@defproc[(content? [v any/c]) boolean?]{
Returns @racket[#t] if @racket[v] is a string, symbol,
@racket[element], @racket[multiarg-element], @racket[delayed-element],
@racket[element], @racket[multiarg-element],
@racket[traverse-element], @racket[delayed-element],
@racket[part-relative-element], or list of @tech{content}, @racket[#f]
otherwise.}
@ -1065,6 +1124,45 @@ Converts a @racket[generated-tag] value with @racket[t] to a string.
}
@defproc[(traverse-block-block [b traverse-block?]
[i (or/c resolve-info? collect-info?)])
block?]{
Produces the block that replaces @racket[b].}
@defproc[(traverse-element-content [e traverse-element?]
[i (or/c resolve-info? collect-info?)])
content?]{
Produces the content that replaces @racket[e].}
@defthing[block-traverse-procedure/c contract?]{
Defined as
@schemeblock[
(recursive-contract
((symbol? any/c . -> . any/c)
(symbol? any/c . -> . any)
. -> . (or/c block-traverse-procedure/c
block?)))
]}
@defthing[element-traverse-procedure/c contract?]{
Defined as
@schemeblock[
(recursive-contract
((symbol? any/c . -> . any/c)
(symbol? any/c . -> . any)
. -> . (or/c element-traverse-procedure/c
content?)))
]}
@; ----------------------------------------
@section{HTML Style Properties}

View File

@ -63,12 +63,23 @@ different root path (indicating that the destination files have
moved).}
@defmethod[(traverse [srcs (listof part?)]
[dests (listof path-string?)])
(and/c hash? immutable?)]{
Performs the @techlink{traverse pass}, producing a hash table that
contains the replacements for and @racket[traverse-block]s and
@racket[traverse-elements]s. See @method[render% render] for
information on the @racket[dests] argument.}
@defmethod[(collect [srcs (listof part?)]
[dests (listof path-string?)])
[dests (listof path-string?)]
[fp (and/c hash? immutable?)])
collect-info?]{
Performs the @techlink{collect pass}. See @method[render% render] for
information on the @racket[dests] argument.}
information on the @racket[dests] argument. The @racket[fp] argument
is a result from the @method[render% traverse] method.}
@defmethod[(resolve [srcs (listof part?)]
[dests (listof path-string?)]
@ -76,14 +87,16 @@ information on the @racket[dests] argument.}
resolve-info?]{
Performs the @techlink{resolve pass}. See @method[render% render] for
information on the @racket[dests] argument.}
information on the @racket[dests] argument. The @racket[ci] argument
is a result from the @method[render% collect] method.}
@defmethod[(render [srcs (listof part?)]
[dests (listof path-string?)]
[ri resolve-info?])
void?]{
Produces the final output.
Produces the final output. The @racket[ri] argument is a result from
the @method[render% render] method.
The @racket[dests] provide names of files for Latex or single-file
HTML output, or names of sub-directories for multi-file HTML output.