From 0c109026093e6fa8730efe0d7454656275d6efe3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 28 May 2021 17:32:58 +0200 Subject: grafts: Cache the derivation/graft mapping for the whole session. Partly fixes . Reported by Lars-Dominik Braun . 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!'. --- guix/grafts.scm | 36 ++++++++++++++++++++++++------------ 1 file changed, 24 insertions(+), 12 deletions(-) (limited to 'guix/grafts.scm') diff --git a/guix/grafts.scm b/guix/grafts.scm index e5672268b1..4c69eb35a2 100644 --- a/guix/grafts.scm +++ b/guix/grafts.scm @@ -172,6 +172,10 @@ references." items)))) (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! (cache-lookup-recorder "derivation-graft-cache" "Derivation graft cache")) @@ -271,7 +275,7 @@ derivations to the corresponding set of grafts." #:system system))))) (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) (() ;no dependencies (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. That is, if GRAFTS apply only indirectly to DRV, graft the dependencies of DRV, and graft DRV itself to refer to those grafted dependencies." - (match (run-with-state - (cumulative-grafts store drv grafts - #:outputs outputs - #:guile guile #:system system) - vlist-null) ;the initial cache - ((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)))) + (let ((grafts cache + (run-with-state + (cumulative-grafts store drv grafts + #:outputs outputs + #:guile guile #:system system) + (store-connection-cache store %graft-cache)))) + + ;; Save CACHE in STORE to benefit from it on the next call. + ;; XXX: Ideally we'd use %STORE-MONAD and 'mcached' and avoid mutating + ;; STORE. + (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 -- cgit v1.2.3