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

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

[Ricardo Wurmus]

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

Hi Guix,

this patch set improves performance of inferior lookups by caching previous
results.  The change in inferior-package->manifest-entry has the biggest
impact in my test case, where I'm building a profile consisting of a few R
packages.  Without this patch it takes more than 14 seconds.  With cached
results it takes less than a second.

Included is a patch that Ludo provided on #guix-hpc for which I wrote a
commit message.

The test case is attached.

Ludovic Courtès (1):
  inferior: Memoize package input field access.

Ricardo Wurmus (3):
  guix: Fix typo.
  inferior: Memoize inferior-package->manifest-entry.
  inferior: Memoize inferior package search path access.

 guix/inferior.scm | 155 ++++++++++++++++++++++++----------------------
 1 file changed, 81 insertions(+), 74 deletions(-)


base-commit: 90a6ce0b1852608185e3ba7fe09e585b43eac3be
-- 
2.29.2


-- 
Ricardo


[-- Attachment #2: inferior-slow.scm --]
[-- Type: text/plain, Size: 1371 bytes --]

(import (guix packages)
        (guix inferior)
        (guix store)
        (guix monads)(guix gexp)
        (guix profiles)
        (guix derivations)
        (ice-9 match)
        (srfi srfi-19))

(pk 'current-guix)
(define current-guix
  ;; /home/rekado/.config/guix/current
  (let* ((default-guix "/gnu/store/ig6alp71w39bmfy51f1w32z0k2rbh6ra-profile")
         (current-guix-inferior #false))
    (lambda ()
      (or current-guix-inferior
          (begin
            (set! current-guix-inferior (open-inferior
                                         (canonicalize-path default-guix)))
            current-guix-inferior)))))

(define (lookup-package specification)
  (match (lookup-inferior-packages (current-guix) specification)
    ((first . rest) first)
    (x (error "oops" x))))

(define specs
  (list "bash-minimal"
        "r-minimal"
        "r-ggplot2"
        "r-ggrepel"
        "r-deseq2"
        "r-dt"
        "r-pheatmap"
        "r-corrplot"
        "r-reshape2"
        "r-plotly"
        "r-scales"
        "r-crosstalk"
        "r-gprofiler"
        "r-rtracklayer"
        "r-summarizedexperiment"))

(pk 'packages)
(define packages
  (map lookup-package specs))

(pk 'packages->manifest)
(let ((start (current-time)))
  (let ((manifest (packages->manifest packages)))
    (pk 'packages->manifest-done (time-difference (current-time) start))))

[bug#46101] [PATCH 1/4] guix: Fix typo.

[Ricardo Wurmus]

* guix/inferior.scm (inferior-available-packages): Remove extra word in
docstring.
---
 guix/inferior.scm | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 2fe91beaab..da6983d9a6 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -311,8 +311,7 @@ Raise '&inferior-exception' when an exception is read from PORT."
   "Return the list of name/version pairs corresponding to the set of packages
 available in INFERIOR.
 
-This is faster and requires less resource-intensive than calling
-'inferior-packages'."
+This is faster and less resource-intensive than calling 'inferior-packages'."
   (if (inferior-eval '(defined? 'fold-available-packages)
                      inferior)
       (inferior-eval '(fold-available-packages
-- 
2.29.2

[bug#46102] [PATCH 2/4] inferior: Memoize inferior-package->manifest-entry.

[Ricardo Wurmus]

* guix/inferior.scm (inferior-package->manifest-entry): Memoize.
---
 guix/inferior.scm | 55 ++++++++++++++++++++++++++---------------------
 1 file changed, 30 insertions(+), 25 deletions(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index da6983d9a6..7bfce5d810 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -639,31 +640,35 @@ failing when GUIX is too old and lacks the 'guix repl' command."
 ;;; Manifest entries.
 ;;;
 
-(define* (inferior-package->manifest-entry package
-                                           #:optional (output "out")
-                                           #:key (parent (delay #f))
-                                           (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 inferior-package->manifest-entry
+  (let ((results vlist-null))
+    (lambda* (package #:optional (output "out")
+                      #:key (parent (delay #f))
+                      (properties '()))
+      "Return a manifest entry for the OUTPUT of package PACKAGE."
+      (or (and=> (vhash-assoc package results) cdr)
+          ;; 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))))
+            (begin
+              (set! results (vhash-cons package entry results))
+              entry))))))
 
 \f
 ;;;
-- 
2.29.2

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

[Ludovic Courtès]

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

Hi!

Thanks for digging into this!

Ricardo Wurmus <rekado@elephly.net> skribis:

> +(define inferior-package->manifest-entry
> +  (let ((results vlist-null))
> +    (lambda* (package #:optional (output "out")
> +                      #:key (parent (delay #f))
> +                      (properties '()))
> +      "Return a manifest entry for the OUTPUT of package PACKAGE."
> +      (or (and=> (vhash-assoc package results) cdr)

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.

So I came up with the attached patch, which addresses these two issues.

For me the ‘packages->manifest’ phase goes from 13s to 2.5s (19s to 4.6s
for the whole script), which is still a lot, but that was without the
other patches.

Thoughts?

Ludo’.


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

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 2fe91beaab..91bbb5aa70 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -109,13 +109,14 @@
 
 ;; Inferior Guix process.
 (define-record-type <inferior>
-  (inferior pid socket close version packages table)
+  (inferior pid socket close version packages id-table table)
   inferior?
   (pid      inferior-pid)
   (socket   inferior-socket)
   (close    inferior-close-socket)               ;procedure
   (version  inferior-version)                    ;REPL protocol version
   (packages inferior-package-promise)            ;promise of inferior packages
+  (id-table inferior-package-id-table)           ;promise of vhash
   (table    inferior-package-table))             ;promise of vhash
 
 (define* (inferior-pipe directory command error-port)
@@ -160,6 +161,7 @@ inferior."
     (('repl-version 0 rest ...)
      (letrec ((result (inferior 'pipe pipe close (cons 0 rest)
                                 (delay (%inferior-packages result))
+                                (delay (%inferior-package-id-table result))
                                 (delay (%inferior-package-table result)))))
 
        ;; For protocol (0 1) and later, send the protocol version we support.
@@ -295,6 +297,18 @@ Raise '&inferior-exception' when an exception is read from PORT."
             (inferior-package inferior name version id)))
          result)))
 
+(define (%inferior-package-id-table inferior)
+  (fold (lambda (package table)
+          (vhash-consv (inferior-package-id package) package
+                       table))
+        vlist-null
+        (inferior-packages inferior)))
+
+(define (lookup-inferior-package-by-id inferior id)
+  (match (vhash-assv id (force (inferior-package-id-table inferior)))
+    (#f #f)
+    ((_ . package) package)))
+
 (define (inferior-packages inferior)
   "Return the list of packages known to INFERIOR."
   (force (inferior-package-promise inferior)))
@@ -412,8 +426,10 @@ inferior package."
 
   (map (match-lambda
          ((label ('package id name version) . rest)
-          ;; XXX: eq?-ness of inferior packages is not preserved here.
-          `(,label ,(inferior-package inferior name version id)
+          ;; XXX: eq?-ness of inferior packages is preserved, unless the
+          ;; package is not public.
+          `(,label ,(or (lookup-inferior-package-by-id inferior id)
+                        (inferior-package inferior name version id))
                    ,@rest))
          (x x))
        inputs))
@@ -642,29 +658,50 @@ 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)))
+      (match (hashq-ref cache package)
+        (#f
+         (let ((result (compute)))
+           (hashq-set! cache package `((,output . ,result)))
+           result))
+        (alist
+         (match (assoc-ref alist output)
+           (#f
+            (let ((result (compute)))
+              (hashq-set! cache package
+                          `((, output . ,result) ,@alist))
+              result))
+           (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 +787,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:
diff --git a/tests/inferior.scm b/tests/inferior.scm
index 7c3d730d0c..ddfae8236d 100644
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -195,6 +195,25 @@
     (close-inferior inferior)
     result))
 
+(test-assert "inferior-package-inputs & pointer identity"
+  (let* ((inferior (open-inferior %top-builddir
+                                  #:command "scripts/guix"))
+         (lookup       (lambda (name)
+                         (first (lookup-inferior-packages inferior name))))
+         (guile-gcrypt (lookup "guile-gcrypt"))
+         (libgcrypt    (lookup "libgcrypt"))
+         (pkg-config   (lookup "pkg-config")))
+    (define (input name)
+      (match (assoc name (inferior-package-inputs guile-gcrypt))
+        ((label package . _) package)))
+
+    (and (eq? libgcrypt
+              (car (assoc-ref (inferior-package-inputs guile-gcrypt)
+                              "libgcrypt")))
+         (eq? pkg-config
+              (car (assoc-ref (inferior-package-native-inputs guile-gcrypt)
+                              "pkg-config"))))))
+
 (test-equal "inferior-package-search-paths"
   (package-native-search-paths guile-3.0)
   (let* ((inferior (open-inferior %top-builddir

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

[Ludovic Courtès]

[-- 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:

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

[Ricardo Wurmus]

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

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

This looks good to me.

It is very similar to my first version (which I didn’t send to the
list), which also built a key consisting of the arguments to
inferior-package->manifest-entry — I wasn’t sure which of them was
important so I used them all instead of just consing package and
output.

I also like the use of define-syntax-rule to make it all look neater.


-- 
Ricardo

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

[Ludovic Courtès]

Ricardo Wurmus <rekado@elephly.net> skribis:

> Ludovic Courtès <ludo@gnu.org> writes:
>
>> 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.
>
> This looks good to me.
>
> It is very similar to my first version (which I didn’t send to the
> list), which also built a key consisting of the arguments to
> inferior-package->manifest-entry — I wasn’t sure which of them was
> important so I used them all instead of just consing package and
> output.
>
> I also like the use of define-syntax-rule to make it all look neater.

I pushed it as 0f20b3fa2050ba6e442e340a204516b9375cd231.

I wonder if the other patches improve the situation.  If you run the
same test case with:

  GUIX_PROFILING=memoization

what hit rates does it show for these spots?

Thanks,
Ludo’.

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

[Ricardo Wurmus]

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

> I pushed it as 0f20b3fa2050ba6e442e340a204516b9375cd231.

Thanks!

> I wonder if the other patches improve the situation.  If you run the
> same test case with:
>
>   GUIX_PROFILING=memoization
>
> what hit rates does it show for these spots?

Memoization: 15 tables, 2 non-empty
  guix/inferior.scm:438:2: 	403 entries, 403 lookups, 0% hits
  guix/inferior.scm:392:2: 	403 entries, 403 lookups, 0% hits

So, I guess we can drop those two patches.

-- 
Ricardo