[bug#46100] [PATCH 4/4] inferior: Memoize package input field access.

[Ricardo Wurmus <rekado@elephly.net>]

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

* guix/inferior.scm (inferior-package-input-field): Return memoized procedure
accepting a package.
(inferior-package-inputs, inferior-package-native-inputs,
inferior-package-propagated-inputs,
inferior-package-transitive-propagated-inputs): Adapt.
---
 guix/inferior.scm | 71 ++++++++++++++++++++++++-----------------------
 1 file changed, 36 insertions(+), 35 deletions(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 0c85a9ea08..b5e8939a1d 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -386,50 +386,51 @@ record."
                                              loc)))
                                      package-location))))
 
-(define (inferior-package-input-field package field)
+(define (inferior-package-input-field field)
   "Return the input field FIELD (e.g., 'native-inputs') of PACKAGE, an
 inferior package."
-  (define field*
-    `(compose (lambda (inputs)
-                (map (match-lambda
-                       ;; XXX: Origins are not handled.
-                       ((label (? package? package) rest ...)
-                        (let ((id (object-address package)))
-                          (hashv-set! %package-table id package)
-                          `(,label (package ,id
-                                            ,(package-name package)
-                                            ,(package-version package))
-                                   ,@rest)))
-                       (x
-                        x))
-                     inputs))
-              ,field))
-
-  (define inputs
-    (inferior-package-field package field*))
-
-  (define inferior
-    (inferior-package-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)
-                   ,@rest))
-         (x x))
-       inputs))
+  (mlambdaq (package)
+    (define field*
+      `(compose (lambda (inputs)
+                  (map (match-lambda
+                         ;; XXX: Origins are not handled.
+                         ((label (? package? package) rest ...)
+                          (let ((id (object-address package)))
+                            (hashv-set! %package-table id package)
+                            `(,label (package ,id
+                                              ,(package-name package)
+                                              ,(package-version package))
+                                     ,@rest)))
+                         (x
+                          x))
+                       inputs))
+                ,field))
+
+    (define inputs
+      (inferior-package-field package field*))
+
+    (define inferior
+      (inferior-package-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)
+                     ,@rest))
+           (x x))
+         inputs)))
 
 (define inferior-package-inputs
-  (cut inferior-package-input-field <> 'package-inputs))
+  (inferior-package-input-field 'package-inputs))
 
 (define inferior-package-native-inputs
-  (cut inferior-package-input-field <> 'package-native-inputs))
+  (inferior-package-input-field 'package-native-inputs))
 
 (define inferior-package-propagated-inputs
-  (cut inferior-package-input-field <> 'package-propagated-inputs))
+  (inferior-package-input-field 'package-propagated-inputs))
 
 (define inferior-package-transitive-propagated-inputs
-  (cut inferior-package-input-field <> 'package-transitive-propagated-inputs))
+  (inferior-package-input-field 'package-transitive-propagated-inputs))
 
 (define (%inferior-package-search-paths field)
   "Return the list of search path specifications of PACKAGE, an inferior
-- 
2.29.2