diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2016-05-25 15:22:36 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2016-05-25 23:33:56 +0200 |
| commit | 1fd11c92592eb4e63d6044c7c840dcb69b9e65e6 (patch) | |
| tree | c2fa1bbff28e80801f97d7736050bb458fff6932 | |
| parent | 25e0037a2925d56b54ece6e42da838c5be656a52 (diff) | |
| download | patches-1fd11c92592eb4e63d6044c7c840dcb69b9e65e6.tar patches-1fd11c92592eb4e63d6044c7c840dcb69b9e65e6.tar.gz | |
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.
| -rw-r--r-- | guix/grafts.scm | 27 |
1 files changed, 17 insertions, 10 deletions
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)) |