diff options
author | Ludovic Courtès <ludo@gnu.org> | 2014-04-29 18:13:10 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2014-04-29 18:13:10 +0200 |
commit | be4e38fb6f8f2da9de4f9c6ff9e448a9dc178c8d (patch) | |
tree | 1aa8c8569085ee3d2734a119300eead5d62bd787 | |
parent | 2c6b7c7d55772be745e8cc615a0868ccc2182e62 (diff) | |
download | patches-be4e38fb6f8f2da9de4f9c6ff9e448a9dc178c8d.tar patches-be4e38fb6f8f2da9de4f9c6ff9e448a9dc178c8d.tar.gz |
derivations: Micro-optimize 'derivation'.
* guix/derivations.scm (derivation->string): New procedure.
(derivation-hash, derivation): Use it.
Memoization here yields a 5% improvement on "guix build -e '(@ (gnu
packages emacs) emacs)' -n --no-substitutes".
-rw-r--r-- | guix/derivations.scm | 15 |
1 files changed, 10 insertions, 5 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm index a3a4eae6ac..09b7ec079e 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -435,6 +435,14 @@ that form." port) (display ")" port)))) +(define derivation->string + (memoize + (lambda (drv) + "Return the external representation of DRV as a string." + (with-fluids ((%default-port-encoding "UTF-8")) + (call-with-output-string + (cut write-derivation drv <>)))))) + (define* (derivation->output-path drv #:optional (output "out")) "Return the store path of its output OUTPUT." (let ((outputs (derivation-outputs drv))) @@ -517,9 +525,7 @@ in SIZE bytes." ;; the SHA256 port's `write' method gets called for every single ;; character. (sha256 - (with-fluids ((%default-port-encoding "UTF-8")) - (string->utf8 (call-with-output-string - (cut write-derivation drv <>))))))))))) + (string->utf8 (derivation->string drv))))))))) (define (store-path type hash name) ; makeStorePath "Return the store path for NAME/HASH/TYPE." @@ -685,8 +691,7 @@ derivations where the costs of data transfers would outweigh the benefits." (drv (add-output-paths drv-masked))) (let ((file (add-text-to-store store (string-append name ".drv") - (call-with-output-string - (cut write-derivation drv <>)) + (derivation->string drv) (map derivation-input-path inputs)))) (set-file-name drv file)))) |