futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

grafts: Create only one grafted variant of each derivation.

Browse Source 
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.
This commit is contained in:
Ludovic Courtès 2016-05-25 15:22:36 +02:00
parent 25e0037a29
commit 1fd11c9259
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 17 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
guix/grafts.scm
View File

@ -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))