From 324a2355796cd175673f982e5ad48ab8d12e05ee Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 22 Mar 2021 22:34:43 +0100
Subject: gexp: Do not add derivations to the object cache.

That was needlessly making the object cache grow.

* guix/gexp.scm (lower-object, lower+expand-object): Bypass the object
cache when OBJ is a derivation.  This almost halves the number of
cache lookups and reduces the number of entries from 3.4K to 2.6K when
doing "guix build libreoffice -d --no-grafts".
---
 guix/gexp.scm | 27 ++++++++++++++++-----------
 1 file changed, 16 insertions(+), 11 deletions(-)

(limited to 'guix/gexp.scm')

diff --git a/guix/gexp.scm b/guix/gexp.scm
index ab83c1e621..142717ed34 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -258,14 +258,17 @@ OBJ must be an object that has an associated gexp compiler, such as a
         (#f
          (raise (condition (&gexp-input-error (input obj)))))
         (lower
-         ;; Cache in STORE the result of lowering OBJ.
-         (mcached (mlet %store-monad ((lowered (lower obj system target)))
-                    (if (and (struct? lowered)
-                             (not (derivation? lowered)))
-                        (loop lowered)
-                        (return lowered)))
-                  obj
-                  system target graft?))))))
+         ;; Cache in STORE the result of lowering OBJ.  If OBJ is a
+         ;; derivation, bypass the cache.
+         (if (derivation? obj)
+             (return obj)
+             (mcached (mlet %store-monad ((lowered (lower obj system target)))
+                        (if (and (struct? lowered)
+                                 (not (derivation? lowered)))
+                            (loop lowered)
+                            (return lowered)))
+                      obj
+                      system target graft?)))))))
 
 (define* (lower+expand-object obj
                               #:optional (system (%current-system))
@@ -280,9 +283,11 @@ expand to file names, but it's possible to expand to a plain data type."
        (raise (condition (&gexp-input-error (input obj)))))
       (lower
        (mlet* %store-monad ((graft?  (grafting?))
-                            (lowered (mcached (lower obj system target)
-                                              obj
-                                              system target graft?)))
+                            (lowered (if (derivation? obj)
+                                         (return obj)
+                                         (mcached (lower obj system target)
+                                                  obj
+                                                  system target graft?))))
          ;; LOWER might return something that needs to be further
          ;; lowered.
          (if (struct? lowered)
-- 
cgit v1.2.3