mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-19 14:07:01 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

derivations: Avoid another call to 'read-derivation-from-file'.

Browse source 
This is a followup to 5cf4b26d52.

* guix/derivations.scm (derivation-path->base16-hash): Rename to...
(derivation-base16-hash): ... this, and take a <derivation> rather than
a file name.  Use 'mlambdaq' instead of 'mlambda'.
(derivation/masked-inputs): Adjust accordingly.
(invalidate-derivation-caches!): Likewise.
This commit is contained in:
Ludovic Courtès 2019-07-03 22:36:56 +02:00
parent 1653b23564
commit c14a2b289d
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 7 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
guix/derivations.scm
View file

@ -652,12 +652,10 @@ (define (derivation-path->output-paths path)
;;; Derivation primitive. ;;; Derivation primitive.
;;; ;;;
(define derivation-path->base16-hash (define derivation-base16-hash
(mlambda (file) (mlambdaq (drv)
"Return a string containing the base16 representation of the hash of the "Return a string containing the base16 representation of the hash of DRV."
derivation at FILE." (bytevector->base16-string (derivation-hash drv))))
(bytevector->base16-string
(derivation-hash (read-derivation-from-file file)))))
(define (derivation/masked-inputs drv) (define (derivation/masked-inputs drv)
"Assuming DRV is a regular derivation (not fixed-output), replace the file "Assuming DRV is a regular derivation (not fixed-output), replace the file
@ -666,9 +664,8 @@ (define (derivation/masked-inputs drv)
(($ <derivation> outputs inputs sources (($ <derivation> outputs inputs sources
system builder args env-vars) system builder args env-vars)
(let ((inputs (map (match-lambda (let ((inputs (map (match-lambda
(($ <derivation-input> (= derivation-file-name path) (($ <derivation-input> drv sub-drvs)
sub-drvs) (let ((hash (derivation-base16-hash drv)))
(let ((hash (derivation-path->base16-hash path)))
(make-derivation-input hash sub-drvs)))) (make-derivation-input hash sub-drvs))))
inputs))) inputs)))
(make-derivation outputs (make-derivation outputs
@ -886,7 +883,7 @@ (define (invalidate-derivation-caches!)
;; Typically this is meant to be used by Cuirass and Hydra, which can clear ;; Typically this is meant to be used by Cuirass and Hydra, which can clear
;; caches when they start evaluating packages for another architecture. ;; caches when they start evaluating packages for another architecture.
(invalidate-memoization! derivation->bytevector) (invalidate-memoization! derivation->bytevector)
(invalidate-memoization! derivation-path->base16-hash) (invalidate-memoization! derivation-base16-hash)
;; FIXME: Comment out to work around <https://bugs.gnu.org/36487>. ;; FIXME: Comment out to work around <https://bugs.gnu.org/36487>.
;; (hash-clear! %derivation-cache) ;; (hash-clear! %derivation-cache)