Archived
1
0
Fork 0

grafts: Cache the derivation/graft mapping for the whole session.

Partly fixes <https://bugs.gnu.org/41702>.
Reported by Lars-Dominik Braun <ldb@leibniz-psychology.org>.

Previously, 'graft-derivation' would start anew at every call.  When
creating a profile with lots of packages, it would potentially do the
same work multiple times.  The per-session cache addresses this.  It
increases the derivation-graft-cache hit rate from 77.9% to 80.1% on:

  GUIX_PROFILING="derivation-graft-cache" ./pre-inst-env \
    guix environment --ad-hoc libreoffice inkscape krita darktable -n

The effect is more visible on the pathological case below, where cache
hit rate goes from 75% to 87% and wall-clock time from 5.0s to 3.5s:

  GUIX_PROFILING="derivation-graft-cache" ./pre-inst-env \
    guix environment --ad-hoc r-learnr --search-paths

* guix/grafts.scm (%graft-cache): New variable.
(graft-derivation): Add calls to 'store-connection-cache' and
'set-store-connection-cache!'.
This commit is contained in:
Ludovic Courtès 2021-05-28 17:32:58 +02:00
parent fde3c349f5
commit 0c10902609
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -172,6 +172,10 @@ references."
items)))) items))))
(remove (cut member <> self) refs))) (remove (cut member <> self) refs)))
(define %graft-cache
;; Cache that maps derivation/outputs/grafts tuples to lists of grafts.
(allocate-store-connection-cache 'grafts))
(define record-cache-lookup! (define record-cache-lookup!
(cache-lookup-recorder "derivation-graft-cache" (cache-lookup-recorder "derivation-graft-cache"
"Derivation graft cache")) "Derivation graft cache"))
@ -271,7 +275,7 @@ derivations to the corresponding set of grafts."
#:system system))))) #:system system)))))
(reference-origins drv items))) (reference-origins drv items)))
(with-cache (cons (derivation-file-name drv) outputs) (with-cache (list (derivation-file-name drv) outputs grafts)
(match (non-self-references store drv outputs) (match (non-self-references store drv outputs)
(() ;no dependencies (() ;no dependencies
(return grafts)) (return grafts))
@ -309,17 +313,25 @@ derivations to the corresponding set of grafts."
"Apply GRAFTS to the OUTPUTS of DRV and all their dependencies, recursively. "Apply GRAFTS to the OUTPUTS of DRV and all their dependencies, recursively.
That is, if GRAFTS apply only indirectly to DRV, graft the dependencies of That is, if GRAFTS apply only indirectly to DRV, graft the dependencies of
DRV, and graft DRV itself to refer to those grafted dependencies." DRV, and graft DRV itself to refer to those grafted dependencies."
(match (run-with-state (let ((grafts cache
(cumulative-grafts store drv grafts (run-with-state
#:outputs outputs (cumulative-grafts store drv grafts
#:guile guile #:system system) #:outputs outputs
vlist-null) ;the initial cache #:guile guile #:system system)
((first . rest) (store-connection-cache store %graft-cache))))
;; If FIRST is not a graft for DRV, it means that GRAFTS are not
;; applicable to DRV and nothing needs to be done. ;; Save CACHE in STORE to benefit from it on the next call.
(if (equal? drv (graft-origin first)) ;; XXX: Ideally we'd use %STORE-MONAD and 'mcached' and avoid mutating
(graft-replacement first) ;; STORE.
drv)))) (set-store-connection-cache! store %graft-cache cache)
(match grafts
((first . rest)
;; If FIRST is not a graft for DRV, it means that GRAFTS are not
;; applicable to DRV and nothing needs to be done.
(if (equal? drv (graft-origin first))
(graft-replacement first)
drv)))))
;; The following might feel more at home in (guix packages) but since (guix ;; The following might feel more at home in (guix packages) but since (guix