store: Use a decaying cutoff in 'map/accumulate-builds'.
This reduces the wall-clock time of: ./pre-inst-env guix system vm gnu/system/examples/desktop.tmpl -n from 2m13s to 53s (the timings depend on which derivations have already been built and are in store; in this case, many were missing). * guix/store.scm (default-cutoff): New variable. (map/accumulate-builds): Use it. Parameterize it in recursive calls to have decaying cutoff.
parent
001f4afd07
commit
2f17089371
|
@ -1362,8 +1362,12 @@ object, only for build requests on EXPECTED-STORE."
|
||||||
(unresolved things continue)
|
(unresolved things continue)
|
||||||
(continue #t))))
|
(continue #t))))
|
||||||
|
|
||||||
|
(define default-cutoff
|
||||||
|
;; Default cutoff parameter for 'map/accumulate-builds'.
|
||||||
|
(make-parameter 32))
|
||||||
|
|
||||||
(define* (map/accumulate-builds store proc lst
|
(define* (map/accumulate-builds store proc lst
|
||||||
#:key (cutoff 30))
|
#:key (cutoff (default-cutoff)))
|
||||||
"Apply PROC over each element of LST, accumulating 'build-things' calls and
|
"Apply PROC over each element of LST, accumulating 'build-things' calls and
|
||||||
coalescing them into a single call.
|
coalescing them into a single call.
|
||||||
|
|
||||||
|
@ -1377,21 +1381,24 @@ CUTOFF is the threshold above which we stop accumulating unresolved nodes."
|
||||||
(build-accumulator store))
|
(build-accumulator store))
|
||||||
|
|
||||||
(define-values (result rest)
|
(define-values (result rest)
|
||||||
(let loop ((lst lst)
|
;; Have the default cutoff decay as we go deeper in the call stack to
|
||||||
(result '())
|
;; avoid pessimal behavior.
|
||||||
(unresolved 0))
|
(parameterize ((default-cutoff (quotient cutoff 2)))
|
||||||
(match lst
|
(let loop ((lst lst)
|
||||||
((head . tail)
|
(result '())
|
||||||
(match (with-build-handler accumulator
|
(unresolved 0))
|
||||||
(proc head))
|
(match lst
|
||||||
((? unresolved? obj)
|
((head . tail)
|
||||||
(if (>= unresolved cutoff)
|
(match (with-build-handler accumulator
|
||||||
(values (reverse (cons obj result)) tail)
|
(proc head))
|
||||||
(loop tail (cons obj result) (+ 1 unresolved))))
|
((? unresolved? obj)
|
||||||
(obj
|
(if (>= unresolved cutoff)
|
||||||
(loop tail (cons obj result) unresolved))))
|
(values (reverse (cons obj result)) tail)
|
||||||
(()
|
(loop tail (cons obj result) (+ 1 unresolved))))
|
||||||
(values (reverse result) lst)))))
|
(obj
|
||||||
|
(loop tail (cons obj result) unresolved))))
|
||||||
|
(()
|
||||||
|
(values (reverse result) lst))))))
|
||||||
|
|
||||||
(match (append-map (lambda (obj)
|
(match (append-map (lambda (obj)
|
||||||
(if (unresolved? obj)
|
(if (unresolved? obj)
|
||||||
|
|
Reference in New Issue