aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-04-16 10:26:46 +0200
committerLudovic Courtès <ludo@gnu.org>2019-04-16 17:30:21 +0200
commit3961edf2304bcff4c402a29868f8c559a03c0663 (patch)
treeecf18e83bd454f75e1ca12dc21554f7193e21296
parentb744862704241f2ceb5b64fabccf5bff2a8fd781 (diff)
downloadpatches-3961edf2304bcff4c402a29868f8c559a03c0663.tar
patches-3961edf2304bcff4c402a29868f8c559a03c0663.tar.gz
store: Memoize 'built-in-builders' call directly in <store-connection>.
The caching strategy introduced in 40cc850aebb497faed0a11d867d8fcee729023df was ineffective since we regularly start from an empty object cache. For example, "guix build inkscape -n" would make 241 'built-in-builders' RPCs. * guix/store.scm (<store-connection>)[built-in-builders]: New field. (open-connection): Adjust '%make-store-connection' call accordingly. (port->connection): Likewise. (built-in-builders): Rename to... (%built-in-builders): ... this. (built-in-builders): New procedure. * guix/download.scm (built-in-builders*): Remove 'mcached' call.
-rw-r--r--guix/download.scm8
-rw-r--r--guix/store.scm49
2 files changed, 34 insertions, 23 deletions
diff --git a/guix/download.scm b/guix/download.scm
index 8865777818..11984cf671 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
@@ -415,11 +415,7 @@
(object->string %content-addressed-mirrors)))
(define built-in-builders*
- (let ((proc (store-lift built-in-builders)))
- (lambda ()
- "Return, as a monadic value, the list of built-in builders supported by
-the daemon; cache the return value."
- (mcached (proc) built-in-builders))))
+ (store-lift built-in-builders))
(define* (built-in-download file-name url
#:key system hash-algo hash
diff --git a/guix/store.scm b/guix/store.scm
index fdd04f349d..9c195c335c 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -368,7 +368,9 @@
(ats-cache store-connection-add-to-store-cache)
(atts-cache store-connection-add-text-to-store-cache)
(object-cache store-connection-object-cache
- (default vlist-null))) ;vhash
+ (default vlist-null)) ;vhash
+ (built-in-builders store-connection-built-in-builders
+ (default (delay '())))) ;promise
(set-record-type-printer! <store-connection>
(lambda (obj port)
@@ -557,13 +559,17 @@ for this connection will be pinned. Return a server object."
(write-int cpu-affinity port)))
(when (>= (protocol-minor v) 11)
(write-int (if reserve-space? 1 0) port))
- (let ((conn (%make-store-connection port
- (protocol-major v)
- (protocol-minor v)
- output flush
- (make-hash-table 100)
- (make-hash-table 100)
- vlist-null)))
+ (letrec* ((built-in-builders
+ (delay (%built-in-builders conn)))
+ (conn
+ (%make-store-connection port
+ (protocol-major v)
+ (protocol-minor v)
+ output flush
+ (make-hash-table 100)
+ (make-hash-table 100)
+ vlist-null
+ built-in-builders)))
(let loop ((done? (process-stderr conn)))
(or done? (process-stderr conn)))
conn)))))))))
@@ -578,13 +584,17 @@ already taken place on PORT and that we're just continuing on this established
connection. Use with care."
(let-values (((output flush)
(buffering-output-port port (make-bytevector 8192))))
- (%make-store-connection port
- (protocol-major version)
- (protocol-minor version)
- output flush
- (make-hash-table 100)
- (make-hash-table 100)
- vlist-null)))
+ (define connection
+ (%make-store-connection port
+ (protocol-major version)
+ (protocol-minor version)
+ output flush
+ (make-hash-table 100)
+ (make-hash-table 100)
+ vlist-null
+ (delay (%built-in-builders connection))))
+
+ connection))
(define (store-connection-version store)
"Return the protocol version of STORE as an integer."
@@ -1371,13 +1381,13 @@ that there is no guarantee that the order of the resulting list matches the
order of PATHS."
substitutable-path-list))
-(define built-in-builders
+(define %built-in-builders
(let ((builders (operation (built-in-builders)
"Return the built-in builders."
string-list)))
(lambda (store)
"Return the names of the supported built-in derivation builders
-supported by STORE."
+supported by STORE. The result is memoized for STORE."
;; Check whether STORE's version supports this RPC and built-in
;; derivation builders in general, which appeared in Guix > 0.11.0.
;; Return the empty list if it doesn't. Note that this RPC does not
@@ -1388,6 +1398,11 @@ supported by STORE."
(builders store)
'()))))
+(define (built-in-builders store)
+ "Return the names of the supported built-in derivation builders
+supported by STORE."
+ (force (store-connection-built-in-builders store)))
+
(define-operation (optimize-store)
"Optimize the store by hard-linking identical files (\"deduplication\".)
Return #t on success."