From 1fd11c92592eb4e63d6044c7c840dcb69b9e65e6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 25 May 2016 15:22:36 +0200 Subject: grafts: Create only one grafted variant of each derivation. Currently, with several grafts applicable to Inkscape, this makes: guix gc -R $(guix build inkscape -d) | wc -l go from 2376 to 2266 (4.6%). * guix/grafts.scm (cumulative-grafts): Pass 'graft-derivation/shallow' the subset of GRAFTS that applies to DRV. --- guix/grafts.scm | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) (limited to 'guix/grafts.scm') diff --git a/guix/grafts.scm b/guix/grafts.scm index 6bec999ad2..53e697688a 100644 --- a/guix/grafts.scm +++ b/guix/grafts.scm @@ -252,16 +252,23 @@ derivations to the corresponding set of grafts." (deps ;one or more dependencies (mlet %state-monad ((grafts (mapm %state-monad dependency-grafts deps)) (cache (current-state))) - (let* ((grafts (delete-duplicates (concatenate grafts) equal?)) - (origins (map graft-origin-file-name grafts))) - (if (find (cut member <> deps) origins) - (let* ((new (graft-derivation/shallow store drv grafts - #:guile guile - #:system system)) - (grafts (cons (graft (origin drv) (replacement new)) - grafts))) - (return/cache cache grafts)) - (return/cache cache grafts)))))))))) + (let* ((grafts (delete-duplicates (concatenate grafts) equal?)) + (origins (map graft-origin-file-name grafts))) + (match (filter (lambda (graft) + (member (graft-origin-file-name graft) deps)) + grafts) + (() + (return/cache cache grafts)) + ((applicable ..1) + ;; Use APPLICABLE, the subset of GRAFTS that is really + ;; applicable to DRV, to avoid creating several identical + ;; grafted variants of DRV. + (let* ((new (graft-derivation/shallow store drv applicable + #:guile guile + #:system system)) + (grafts (cons (graft (origin drv) (replacement new)) + grafts))) + (return/cache cache grafts)))))))))))) (define* (graft-derivation store drv grafts #:key (guile (%guile-for-build)) -- cgit v1.2.3