mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-02-05 18:29:28 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

gexp: Do not add derivations to the object cache.

Browse source 
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".
This commit is contained in:
Ludovic Courtès 2021-03-22 22:34:43 +01:00
parent a779363b6a
commit 324a235579
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 16 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
guix/gexp.scm
View file

@ -258,14 +258,17 @@ OBJ must be an object that has an associated gexp compiler, such as a
(#f (#f
(raise (condition (&gexp-input-error (input obj))))) (raise (condition (&gexp-input-error (input obj)))))
(lower (lower
;; Cache in STORE the result of lowering OBJ. ;; 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))) (mcached (mlet %store-monad ((lowered (lower obj system target)))
(if (and (struct? lowered) (if (and (struct? lowered)
(not (derivation? lowered))) (not (derivation? lowered)))
(loop lowered) (loop lowered)
(return lowered))) (return lowered)))
obj obj
system target graft?)))))) system target graft?)))))))
(define* (lower+expand-object obj (define* (lower+expand-object obj
#:optional (system (%current-system)) #: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))))) (raise (condition (&gexp-input-error (input obj)))))
(lower (lower
(mlet* %store-monad ((graft? (grafting?)) (mlet* %store-monad ((graft? (grafting?))
(lowered (mcached (lower obj system target) (lowered (if (derivation? obj)
(return obj)
(mcached (lower obj system target)
obj obj
system target graft?))) system target graft?))))
;; LOWER might return something that needs to be further ;; LOWER might return something that needs to be further
;; lowered. ;; lowered.
(if (struct? lowered) (if (struct? lowered)