aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-04-29 18:13:10 +0200
committerLudovic Courtès <ludo@gnu.org>2014-04-29 18:13:10 +0200
commitbe4e38fb6f8f2da9de4f9c6ff9e448a9dc178c8d (patch)
tree1aa8c8569085ee3d2734a119300eead5d62bd787
parent2c6b7c7d55772be745e8cc615a0868ccc2182e62 (diff)
downloadguix-be4e38fb6f8f2da9de4f9c6ff9e448a9dc178c8d.tar
guix-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.scm15
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))))