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

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

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