diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-04-16 10:26:46 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-04-16 17:30:21 +0200 |
commit | 3961edf2304bcff4c402a29868f8c559a03c0663 (patch) | |
tree | ecf18e83bd454f75e1ca12dc21554f7193e21296 | |
parent | b744862704241f2ceb5b64fabccf5bff2a8fd781 (diff) |
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.scm | 8 | ||||
-rw-r--r-- | guix/store.scm | 49 |
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." |