GNU bug report logs - #71941
Broken `map-derivation' procedure

Previous Next

Full log

View this message in rfc822 format

From: Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>
To: 71941 <at> debbugs.gnu.org
Cc: Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>, Sergio Pastor Pérez <sergio.pastorperez <at> outlook.es>, Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>, Ludovic Courtès <ludo <at> gnu.org>, Christopher Baines <guix <at> cbaines.net>, Josselin Poiret <dev <at> jpoiret.xyz>, Mathieu Othacehe <othacehe <at> gnu.org>, Simon Tournier <zimon.toutoune <at> gmail.com>, Tobias Geerinckx-Rice <me <at> tobias.gr>
Subject: bug#71941: [PATCH v4 2/3] guix: fix: Slow 'map-derivation' procedure
Date: Sat,  1 Mar 2025 19:06:09 +0100

Implement caching to speed up computation through memoization.

Change-Id: I186e2a62f6655e3b0738dd6e0f628faccd8b855e
---
 guix/derivations.scm | 103 ++++++++++++++++++++++---------------------
 1 file changed, 53 insertions(+), 50 deletions(-)

diff --git a/guix/derivations.scm b/guix/derivations.scm
index d84d1a391c..9b44febdb8 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -1060,56 +1060,59 @@ (define* (map-derivation store drv mapping
              (#f
               (derivation-input (loop drv) sub-drvs)))))))
 
-    (let loop ((drv drv))
-      (let* ((inputs       (map (cut rewritten-input <> loop)
-                                (derivation-inputs drv)))
-             (initial      (append-map derivation-input-output-paths
-                                       (derivation-inputs drv)))
-             (replacements (append-map input->output-paths inputs))
-
-             ;; Sources typically refer to the output directories of the
-             ;; original inputs, INITIAL.  Rewrite them by substituting
-             ;; REPLACEMENTS.
-             (sources      (map (lambda (source)
-                                  (match (vhash-assoc source mapping)
-                                    ((_ . replacement)
-                                     replacement)
-                                    (#f
-                                     (if (file-is-directory? source)
-                                         source
-                                         (substitute-file source
-                                                          initial replacements)))))
-                                (derivation-sources drv)))
-
-             ;; Now augment the lists of initials and replacements.
-             (initial      (append (derivation-sources drv) initial))
-             (replacements (append sources replacements))
-             (name         (store-path-package-name
-                            (string-drop-right (derivation-file-name drv)
-                                               4))))
-        (derivation store name
-                    (substitute (derivation-builder drv)
-                                initial replacements)
-                    (map (cut substitute <> initial replacements)
-                         (derivation-builder-arguments drv))
-                    #:system system
-                    #:env-vars (map (match-lambda
-                                     ((var . value)
-                                      `(,var
-                                        . ,(substitute value initial
-                                                       replacements))))
-                                    (derivation-builder-environment-vars drv))
-                    #:inputs (filter derivation-input? inputs)
-                    #:sources (append sources (filter string? inputs))
-                    #:outputs (derivation-output-names drv)
-                    #:hash (match (derivation-outputs drv)
-                             ((($ <derivation-output> _ algo hash))
-                              hash)
-                             (_ #f))
-                    #:hash-algo (match (derivation-outputs drv)
-                                  ((($ <derivation-output> _ algo hash))
-                                   algo)
-                                  (_ #f)))))))
+    (define loop
+      (mlambdaq (drv)
+        (let* ((inputs       (map (cut rewritten-input <> loop)
+                                  (derivation-inputs drv)))
+               (initial      (append-map derivation-input-output-paths
+                                         (derivation-inputs drv)))
+               (replacements (append-map input->output-paths inputs))
+
+               ;; Sources typically refer to the output directories of the
+               ;; original inputs, INITIAL.  Rewrite them by substituting
+               ;; REPLACEMENTS.
+               (sources      (map (lambda (source)
+                                    (match (vhash-assoc source mapping)
+                                      ((_ . replacement)
+                                       replacement)
+                                      (#f
+                                       (if (file-is-directory? source)
+                                           source
+                                           (substitute-file source
+                                                            initial replacements)))))
+                                  (derivation-sources drv)))
+
+               ;; Now augment the lists of initials and replacements.
+               (initial      (append (derivation-sources drv) initial))
+               (replacements (append sources replacements))
+               (name         (store-path-package-name
+                              (string-drop-right (derivation-file-name drv)
+                                                 4))))
+          (derivation store name
+                      (substitute (derivation-builder drv)
+                                  initial replacements)
+                      (map (cut substitute <> initial replacements)
+                           (derivation-builder-arguments drv))
+                      #:system system
+                      #:env-vars (map (match-lambda
+                                        ((var . value)
+                                         `(,var
+                                           . ,(substitute value initial
+                                                          replacements))))
+                                      (derivation-builder-environment-vars drv))
+                      #:inputs (filter derivation-input? inputs)
+                      #:sources (append sources (filter string? inputs))
+                      #:outputs (derivation-output-names drv)
+                      #:hash (match (derivation-outputs drv)
+                               ((($ <derivation-output> _ algo hash))
+                                hash)
+                               (_ #f))
+                      #:hash-algo (match (derivation-outputs drv)
+                                    ((($ <derivation-output> _ algo hash))
+                                     algo)
+                                    (_ #f))))))
+
+    (loop drv)))
 
 
 ;;;
-- 
2.48.1

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.