suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

raco setup: avoid re-rendering

Browse Source 
Fix a problem that triggered too many re-renderings, and fix
intended shortcuts related to build order.
This commit is contained in:
Matthew Flatt 2013-07-13 10:32:21 -06:00
parent a0b66b210f
commit 88c5cc7573
1 changed files with 60 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
pkgs/racket-pkgs/racket-index/setup/scribble.rkt
View File

@ -56,9 +56,8 @@
undef ; unresolved requires undef ; unresolved requires
searches searches
deps ; (listof (cons <path-or-info> hash)) deps ; (listof (cons <path-or-info> hash))
known-deps ; (listof (cons <path-or-info> hash))
build? build?
prev-out-hash out-hash out-hash
start-time done-time start-time done-time
need-run? need-run?
need-in-write? need-out-write? need-in-write? need-out-write?
@ -393,6 +392,7 @@
(log-setup-info "determining dependencies") (log-setup-info "determining dependencies")
(for ([i infos]) (for ([i infos])
(hash-set! src->info (doc-src-file (info-doc i)) i)) (hash-set! src->info (doc-src-file (info-doc i)) i))
(define quick-fix? #f)
(for ([info infos] #:when (info-build? info)) (for ([info infos] #:when (info-build? info))
(let ([one? #f] (let ([one? #f]
[added? #f] [added? #f]
@ -430,8 +430,30 @@
(printf " [Removed Dependency for ~a: ~a]\n" (printf " [Removed Dependency for ~a: ~a]\n"
(doc-name (info-doc info)) (doc-name (info-doc info))
(doc-name (info-doc info)))))))) (doc-name (info-doc info))))))))
(define (add-dependency info i)
(cond
[((info-start-time info) . < . (info-done-time info))
;; Although this dependency wasn't in the list, yet,
;; the build actually happened after the dependency's "out.sxref"
;; files were written, so they would have been used.
;; Fix up the dependency list.
(when (verbose)
(printf " [Quick-add for ~a: ~a]\n"
(doc-name (info-doc info))
(doc-name (info-doc i))))
(hash-set! deps i #t)
(set-info-deps! info (cons (cons i (info-out-hash i))
(info-deps info)))
(set-info-need-in-write?! info #t)]
[else
(when (verbose)
(printf " [Adding for ~a: ~a]\n"
(doc-name (info-doc info))
(doc-name (info-doc i))))
(set! added? #t)
(hash-set! deps i #t)]))
;; Add expected dependencies for an "all dependencies" doc:
(when (or (memq 'depends-all (doc-flags (info-doc info))) all-main?) (when (or (memq 'depends-all (doc-flags (info-doc info))) all-main?)
;; Add all as expected dependency:
(when (verbose) (when (verbose)
(printf " [Adding all~a as dependencies for ~a]\n" (printf " [Adding all~a as dependencies for ~a]\n"
(if all-main? " main" "") (if all-main? " main" "")
@ -442,13 +464,9 @@
(not (hash-ref deps i #f)) (not (hash-ref deps i #f))
(or (not all-main?) (doc-under-main? (info-doc i))) (or (not all-main?) (doc-under-main? (info-doc i)))
(not (memq 'no-depend-on (doc-flags (info-doc i))))) (not (memq 'no-depend-on (doc-flags (info-doc i)))))
(when (verbose) (add-dependency info i))))
(printf " [Adding for ~a: ~a]\n" ;; Determine definite dependencies based on referenced keys, and also
(doc-name (info-doc info)) ;; report missing links.
(doc-name (info-doc i))))
(set! added? #t)
(hash-set! deps i #t))))
;; Add definite dependencies based on referenced keys
(let ([not-found (let ([not-found
(lambda (k) (lambda (k)
(unless (or (memq 'depends-all (doc-flags (info-doc info))) (unless (or (memq 'depends-all (doc-flags (info-doc info)))
@ -477,18 +495,16 @@
(define i (out-path->info found-dep infos out-path->info-cache)) (define i (out-path->info found-dep infos out-path->info-cache))
(unless i (unless i
(error "failed to find info for path: ~s" found-dep)) (error "failed to find info for path: ~s" found-dep))
;; Record this known dependency:
(when (not (hash-ref known-deps i #f)) (when (not (hash-ref known-deps i #f))
(hash-set! known-deps i #t)) (hash-set! known-deps i #t))
;; Record also in the expected-dependency list:
(when (not (hash-ref deps i #f)) (when (not (hash-ref deps i #f))
(set! added? #t) ;; Record dependency in "expected", too, which triggers
(when (verbose) ;; a re-run if needed:
(printf " [Adding for ~a: ~a]\n" (add-dependency info i)))
(doc-name (info-doc info))
(doc-name (info-doc i))))
(hash-set! deps i #t)))
(for ([s-key (in-list missing)]) (for ([s-key (in-list missing)])
(not-found s-key)))) (not-found s-key))))
;; Check whether this document needs a re-run:
(when (or (when (or
;; If we added anything (expected or known), then mark as needed to run: ;; If we added anything (expected or known), then mark as needed to run:
(and added? (and added?
@ -501,6 +517,12 @@
(or (and (not (info? i2)) (or (and (not (info? i2))
i2) i2)
(and (not (equal? (info-out-hash i2) (cdr p))) (and (not (equal? (info-out-hash i2) (cdr p)))
(if ((info-start-time info) . < . (info-done-time info))
(begin
;; Actually used more recent:
(set! quick-fix? #t)
#f)
#t)
i2))) i2)))
(info-deps info))]) (info-deps info))])
(and ch (and ch
@ -510,16 +532,24 @@
(if (info? ch) (if (info? ch)
(doc-name (info-doc ch)) (doc-name (info-doc ch))
ch))))))) ch)))))))
(define (key->dep i v) (cons i (define (key->dep i v) (cons i (info-out-hash i)))
(if ((info-start-time info) . > . (info-done-time i)) (set-info-deps! info (hash-map known-deps key->dep))
;; This document started after latest info was availale:
(info-out-hash i)
;; Used info that was available at the start:
(info-prev-out-hash i))))
(set-info-known-deps! info (hash-map known-deps key->dep))
(set-info-deps! info (info-known-deps info))
(set-info-need-in-write?! info #t) (set-info-need-in-write?! info #t)
(set-info-need-run?! info #t)))) (set-info-need-run?! info #t))
(when (and quick-fix? (not (info-need-run? info)))
;; Because the run was later enough, it actually used the latest
;; "out.sxref" for all dependencies.
(set-info-deps! info (for/list ([dep (in-list (info-deps info))])
(cons (car dep)
(info-out-hash (car dep)))))
(set-info-need-in-write?! info #t))))
;; Write out any "in.sxref" files that have been updated with dependency
;; information, and where another run isn't needed:
(for ([info (in-list infos)])
(when (and (info-need-in-write? info)
(not (info-need-run? info)))
(write-in/info latex-dest info no-lock)
(set-info-need-in-write?! info #f)))
;; Iterate, if any need to run: ;; Iterate, if any need to run:
(when (and (ormap info-need-run? infos) (iter . < . 30)) (when (and (ormap info-need-run? infos) (iter . < . 30))
(log-setup-info "building") (log-setup-info "building")
@ -538,8 +568,7 @@
"~a" "~a"
(path->relative-string/setup (doc-src-file (info-doc i))))) (path->relative-string/setup (doc-src-file (info-doc i)))))
(define (prep-info! i) (define (prep-info! i)
(set-info-start-time! i (current-inexact-milliseconds)) (set-info-start-time! i (current-inexact-milliseconds)))
(set-info-prev-out-hash! i (info-out-hash i)))
(define (update-info! info response) (define (update-info! info response)
(match response (match response
[#f (set-info-failed?! info #t)] [#f (set-info-failed?! info #t)]
@ -948,10 +977,9 @@
;; expected deps, in case we don't need to build: ;; expected deps, in case we don't need to build:
(map (lambda (p) (cons (rel->path (car p)) (cdr p))) (map (lambda (p) (cons (rel->path (car p)) (cdr p)))
(list-ref v-in 1)) (list-ref v-in 1))
null ; known deps (none at this point)
can-run? can-run?
out-hash out-hash out-hash
(current-inexact-milliseconds) -inf.0 -inf.0 -inf.0
(and can-run? (and can-run?
(or (memq 'always-run (doc-flags doc)) (or (memq 'always-run (doc-flags doc))
;; maybe info is up-to-date but not rendered doc: ;; maybe info is up-to-date but not rendered doc:
@ -1011,10 +1039,8 @@
(make-info doc (make-info doc
undef undef
searches searches
null ; no deps, yet null ; haven't figured out deps, yet
null ; no known deps, yet
can-run? can-run?
#f ; prev-out-hash
(and (not need-out-write) (and (not need-out-write)
(get-info-out-hash doc latex-dest)) (get-info-out-hash doc latex-dest))
start-time +inf.0 start-time +inf.0