derivations: Add memoization for ‘map-derivation’.

Implement caching to speed up computation through memoization.

* guix/derivations.scm (map-derivation): Turn ‘loop’ into an ‘mlambdaq’.

Change-Id: I186e2a62f6655e3b0738dd6e0f628faccd8b855e
Signed-off-by: Ludovic Courtès <ludo@gnu.org>

1 files changed, 51 insertions, 48 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 @@ recursively."
              (#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))
+    (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)))
+               ;; 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)))))))
+               ;; 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)))
 
 
 ;;;