[bug#46100] [PATCH 0/4] Memoize inferior package access.

["Ludovic Courtès" <ludo@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 515 bytes --]

Ludovic Courtès <ludo@gnu.org> skribis:

> There’s a catch here: OUTPUT should be taken into account.
>
> Also it’s better to use eq?-ness but… I realized
> ‘inferior-package-inputs’ & co. do not preserve eq?-ness.

I think I went overboard here: given that <inferior-package> is a simple
flat record type, using ‘equal?’/‘hash-ref’ is reasonable and that way
we avoid the troubles of building an ID-to-package table.  All in all
it’s slightly more efficient.

WDYT?

Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 3429 bytes --]

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 2fe91beaab..d813b3b918 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -642,29 +642,41 @@ failing when GUIX is too old and lacks the 'guix repl' command."
 
 (define* (inferior-package->manifest-entry package
                                            #:optional (output "out")
-                                           #:key (parent (delay #f))
-                                           (properties '()))
+                                           #:key (properties '()))
   "Return a manifest entry for the OUTPUT of package PACKAGE."
   ;; For each dependency, keep a promise pointing to its "parent" entry.
-  (letrec* ((deps  (map (match-lambda
-                          ((label package)
-                           (inferior-package->manifest-entry package
-                                                             #:parent (delay entry)))
-                          ((label package output)
-                           (inferior-package->manifest-entry package output
-                                                             #:parent (delay entry))))
-                        (inferior-package-propagated-inputs package)))
-            (entry (manifest-entry
-                     (name (inferior-package-name package))
-                     (version (inferior-package-version package))
-                     (output output)
-                     (item package)
-                     (dependencies (delete-duplicates deps))
-                     (search-paths
-                      (inferior-package-transitive-native-search-paths package))
-                     (parent parent)
-                     (properties properties))))
-    entry))
+  (define cache
+    (make-hash-table))
+
+  (define-syntax-rule (memoized package output exp)
+    (let ((compute (lambda () exp))
+          (key     (cons package output)))
+      (or (hash-ref cache key)
+          (let ((result (compute)))
+            (hash-set! cache key result)
+            result))))
+
+  (let loop ((package package)
+             (output  output)
+             (parent  (delay #f)))
+    (memoized package output
+      (letrec* ((deps  (map (match-lambda
+                              ((label package)
+                               (loop package "out" (delay entry)))
+                              ((label package output)
+                               (loop package output (delay entry))))
+                            (inferior-package-propagated-inputs package)))
+                (entry (manifest-entry
+                         (name (inferior-package-name package))
+                         (version (inferior-package-version package))
+                         (output output)
+                         (item package)
+                         (dependencies (delete-duplicates deps))
+                         (search-paths
+                          (inferior-package-transitive-native-search-paths package))
+                         (parent parent)
+                         (properties properties))))
+        entry))))
 
 \f
 ;;;
@@ -750,3 +762,7 @@ This is a convenience procedure that people may use in manifests passed to
                                #:cache-directory cache-directory
                                #:ttl ttl)))
   (open-inferior cached))
+
+;;; Local Variables:
+;;; eval: (put 'memoized 'scheme-indent-function 1)
+;;; End: