diff options
author | Leo Famulari <leo@famulari.name> | 2017-01-06 17:14:41 -0500 |
---|---|---|
committer | Leo Famulari <leo@famulari.name> | 2017-01-06 17:14:41 -0500 |
commit | 74288230ea8b2310495dc2739f39ceadcc143fd0 (patch) | |
tree | 73ba6c7c13d59c5f92b409c94dccfff159e08f4d /guix/derivations.scm | |
parent | 92e779592d269ca1924f184496eb4ca832997b12 (diff) | |
parent | aa21c764d65068783ae31febee2a92eb3d138a24 (diff) | |
download | guix-patches-74288230ea8b2310495dc2739f39ceadcc143fd0.tar guix-patches-74288230ea8b2310495dc2739f39ceadcc143fd0.tar.gz |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/derivations.scm')
-rw-r--r-- | guix/derivations.scm | 47 |
1 files changed, 26 insertions, 21 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm index 7ed9bd61d3..d5e4b5730b 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -453,19 +453,22 @@ one-argument procedure similar to that returned by 'substitution-oracle'." (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 @@ -520,9 +523,9 @@ that form." (define (write-input input port) (match input (($ <derivation-input> path sub-drvs) - (display "(" port) - (write path port) - (display "," port) + (display "(\"" port) + (display path port) + (display "\"," port) (write-string-list sub-drvs) (display ")" port)))) @@ -545,7 +548,7 @@ that form." (write-list inputs write-input port) (display "," port) (write-string-list sources) - (format port ",~s,~s," system builder) + (simple-format port ",\"~a\",\"~a\"," system builder) (write-string-list args) (display "," port) (write-list env-vars write-env-var port) @@ -866,10 +869,12 @@ output should not be used." 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))) |