guix-patches
[Top][All Lists]
Advanced

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

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


From: Ludovic Courtès
Subject: [bug#46100] [PATCH 0/4] Memoize inferior package access.
Date: Tue, 26 Jan 2021 12:30:34 +0100
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/27.1 (gnu/linux)

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’.

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))))
 
 
 ;;;
@@ -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:

reply via email to

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