guix-commits
[Top][All Lists]
Advanced

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

04/04: store: Use a decaying cutoff in 'map/accumulate-builds'.


From: guix-commits
Subject: 04/04: store: Use a decaying cutoff in 'map/accumulate-builds'.
Date: Wed, 18 May 2022 18:05:20 -0400 (EDT)

civodul pushed a commit to branch master
in repository guix.

commit 2f170893719e6e9fc8e19cc5f0568e20a95d92b4
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri May 13 16:47:49 2022 +0200

    store: Use a decaying cutoff in 'map/accumulate-builds'.
    
    This reduces the wall-clock time of:
    
      ./pre-inst-env guix system vm gnu/system/examples/desktop.tmpl -n
    
    from 2m13s to 53s (the timings depend on which derivations have already
    been built and are in store; in this case, many were missing).
    
    * guix/store.scm (default-cutoff): New variable.
    (map/accumulate-builds): Use it.  Parameterize it in recursive calls to
    have decaying cutoff.
---
 guix/store.scm | 39 +++++++++++++++++++++++----------------
 1 file changed, 23 insertions(+), 16 deletions(-)

diff --git a/guix/store.scm b/guix/store.scm
index 220901f6ce..a3240eb2e0 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -1362,8 +1362,12 @@ object, only for build requests on EXPECTED-STORE."
         (unresolved things continue)
         (continue #t))))
 
+(define default-cutoff
+  ;; Default cutoff parameter for 'map/accumulate-builds'.
+  (make-parameter 32))
+
 (define* (map/accumulate-builds store proc lst
-                                #:key (cutoff 30))
+                                #:key (cutoff (default-cutoff)))
   "Apply PROC over each element of LST, accumulating 'build-things' calls and
 coalescing them into a single call.
 
@@ -1377,21 +1381,24 @@ CUTOFF is the threshold above which we stop 
accumulating unresolved nodes."
     (build-accumulator store))
 
   (define-values (result rest)
-    (let loop ((lst lst)
-               (result '())
-               (unresolved 0))
-      (match lst
-        ((head . tail)
-         (match (with-build-handler accumulator
-                  (proc head))
-           ((? unresolved? obj)
-            (if (>= unresolved cutoff)
-                (values (reverse (cons obj result)) tail)
-                (loop tail (cons obj result) (+ 1 unresolved))))
-           (obj
-            (loop tail (cons obj result) unresolved))))
-        (()
-         (values (reverse result) lst)))))
+    ;; Have the default cutoff decay as we go deeper in the call stack to
+    ;; avoid pessimal behavior.
+    (parameterize ((default-cutoff (quotient cutoff 2)))
+      (let loop ((lst lst)
+                 (result '())
+                 (unresolved 0))
+        (match lst
+          ((head . tail)
+           (match (with-build-handler accumulator
+                    (proc head))
+             ((? unresolved? obj)
+              (if (>= unresolved cutoff)
+                  (values (reverse (cons obj result)) tail)
+                  (loop tail (cons obj result) (+ 1 unresolved))))
+             (obj
+              (loop tail (cons obj result) unresolved))))
+          (()
+           (values (reverse result) lst))))))
 
   (match (append-map (lambda (obj)
                        (if (unresolved? obj)



reply via email to

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