guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

01/07: store: Memoize 'built-in-builders' call directly in <store-connec


From: guix-commits
Subject: 01/07: store: Memoize 'built-in-builders' call directly in <store-connection>.
Date: Tue, 16 Apr 2019 11:33:15 -0400 (EDT)

civodul pushed a commit to branch master
in repository guix.

commit 3961edf2304bcff4c402a29868f8c559a03c0663
Author: Ludovic Courtès <address@hidden>
Date:   Tue Apr 16 10:26:46 2019 +0200

    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.
---
 guix/download.scm |  8 ++------
 guix/store.scm    | 49 ++++++++++++++++++++++++++++++++-----------------
 2 files changed, 34 insertions(+), 23 deletions(-)

diff --git a/guix/download.scm b/guix/download.scm
index 8865777..11984cf 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 
<address@hidden>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès 
<address@hidden>
 ;;; Copyright © 2013, 2014, 2015 Andreas Enge <address@hidden>
 ;;; Copyright © 2015 Federico Beffa <address@hidden>
 ;;; Copyright © 2016 Alex Griffin <address@hidden>
@@ -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 fdd04f3..9c195c3 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."



reply via email to

[Prev in Thread] Current Thread [Next in Thread]