nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
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 (deps ;one or more dependencies
(mlet %state-monad ((grafts (mapm %state-monad dependency-grafts deps)) (mlet %state-monad ((grafts (mapm %state-monad dependency-grafts deps))
(cache (current-state))) (cache (current-state)))
(let* ((grafts (delete-duplicates (concatenate grafts) equal?)) (let* ((grafts (delete-duplicates (concatenate grafts) equal?))
(origins (map graft-origin-file-name grafts))) (origins (map graft-origin-file-name grafts)))
(if (find (cut member <> deps) origins) (match (filter (lambda (graft)
(let* ((new (graft-derivation/shallow store drv grafts (member (graft-origin-file-name graft) deps))
#:guile guile grafts)
#:system system)) (()
(grafts (cons (graft (origin drv) (replacement new)) (return/cache cache grafts))
grafts))) ((applicable ..1)
(return/cache cache grafts)) ;; Use APPLICABLE, the subset of GRAFTS that is really
(return/cache cache grafts)))))))))) ;; 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 (define* (graft-derivation store drv grafts
#:key (guile (%guile-for-build)) #:key (guile (%guile-for-build))