ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-15 03:15:09 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

derivations: Share a cache between 'derivation' and 'read-derivation'.

Browse source 
This leads a 13% speedup on 'guix build libreoffice -d' and 18% on
'guix build gnome -d'.

* guix/derivations.scm (%derivation-cache): New variable.
(read-derivation): Use it instead of the private 'cache' variable.
(derivation): Populate %DERIVATION-CACHE before returning.
This commit is contained in:
Ludovic Courtès 2017-01-05 23:40:59 +01:00
parent fbec5abeef
commit 76c31074c8
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 21 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
guix/derivations.scm
View file

@ -453,19 +453,22 @@ (define (make-input-drvs x)
(loop (read drv-port)
(cons (ununquote exp) result))))))
(define read-derivation
(let ((cache (make-weak-value-hash-table 200)))
(lambda (drv-port)
"Read the derivation from DRV-PORT and return the corresponding
(define %derivation-cache
;; Maps derivation file names to <derivation> objects.
;; XXX: This is redundant with 'atts-cache' in the store.
(make-weak-value-hash-table 200))
(define (read-derivation drv-port)
"Read the derivation from DRV-PORT and return the corresponding
<derivation> object."
;; Memoize that operation because `%read-derivation' is quite expensive,
;; and because the same argument is read more than 15 times on average
;; during something like (package-derivation s gdb).
(let ((file (and=> (port-filename drv-port) basename)))
(or (and file (hash-ref cache file))
(let ((drv (%read-derivation drv-port)))
(hash-set! cache file drv)
drv))))))
;; Memoize that operation because `%read-derivation' is quite expensive,
;; and because the same argument is read more than 15 times on average
;; during something like (package-derivation s gdb).
(let ((file (port-filename drv-port)))
(or (and file (hash-ref %derivation-cache file))
(let ((drv (%read-derivation drv-port)))
(hash-set! %derivation-cache file drv)
drv))))
(define-inlinable (write-sequence lst write-item port)
;; Write each element of LST with WRITE-ITEM to PORT, separating them with a
@ -866,10 +869,12 @@ (define input->derivation-input
system builder args env-vars #f))
(drv (add-output-paths drv-masked)))
(let ((file (add-text-to-store store (string-append name ".drv")
(derivation->string drv)
(map derivation-input-path inputs))))
(set-file-name drv file))))
(let* ((file (add-text-to-store store (string-append name ".drv")
(derivation->string drv)
(map derivation-input-path inputs)))
(drv (set-file-name drv file)))
(hash-set! %derivation-cache file drv)
drv)))
(define* (map-derivation store drv mapping
#:key (system (%current-system)))