From 0f20b3fa2050ba6e442e340a204516b9375cd231 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 27 Jan 2021 23:03:06 +0100 Subject: inferior: Memoize entries in 'inferior-package->manifest-entry'. Fixes a performance issue as reported by Ricardo Wurmus in . * guix/inferior.scm (inferior-package->manifest-entry): Remove #:parent parameter. [cache]: New variable. [memoized]: New macro. [loop]: New procedure. --- guix/inferior.scm | 64 ++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 42 insertions(+), 22 deletions(-) (limited to 'guix/inferior.scm') diff --git a/guix/inferior.scm b/guix/inferior.scm index 2fe91beaab..b8c7f5a334 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -642,29 +642,45 @@ 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) + ;; Memoize the entry returned by EXP for PACKAGE/OUTPUT. This is + ;; important as the same package may be traversed many times through + ;; propagated inputs, and querying the inferior is costly. Use + ;; 'hash'/'equal?', which is okay since is simple. + (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 + ;; For each dependency, keep a promise pointing to its "parent" entry. + (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 +766,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: -- cgit v1.2.3 From 09ab0d42b00d38abb57dd8218062e797d5117080 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Fri, 22 Jan 2021 21:31:51 +0100 Subject: guix: Fix typo. * guix/inferior.scm (inferior-available-packages): Remove extra word in docstring. --- guix/inferior.scm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'guix/inferior.scm') diff --git a/guix/inferior.scm b/guix/inferior.scm index b8c7f5a334..65d7888669 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 -- cgit v1.2.3 From 7cfd789150f448cf5256b88915bae4163cc9db03 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 28 Jan 2021 22:48:21 +0100 Subject: inferior: Speed up 'cached-channel-instance' for cache hits. That way a command like: guix time-machine --commit=5aeee07cc9 -- describe goes from 3.4s to 0.5s on a cache hit, even slightly less when passing the full commit ID. * guix/inferior.scm (channel-full-commit): New procedure. (cached-channel-instance): Remove 'instances' top-level variable. Add 'commits' and use it for 'key'. Move 'latest-channel-instances' call to the cache miss case. --- guix/inferior.scm | 38 ++++++++++++++++++++++++++++++-------- 1 file changed, 30 insertions(+), 8 deletions(-) (limited to 'guix/inferior.scm') diff --git a/guix/inferior.scm b/guix/inferior.scm index 65d7888669..0990696e6c 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 +;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -40,6 +40,7 @@ #:use-module (guix search-paths) #:use-module (guix profiles) #:use-module (guix channels) + #:use-module ((guix git) #:select (update-cached-checkout)) #:use-module (guix monads) #:use-module (guix store) #:use-module (guix derivations) @@ -51,6 +52,7 @@ #:autoload (guix build utils) (mkdir-p) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-71) #:autoload (ice-9 ftw) (scandir) #:use-module (ice-9 match) #:use-module (ice-9 popen) @@ -691,6 +693,21 @@ failing when GUIX is too old and lacks the 'guix repl' command." (make-parameter (string-append (cache-directory #:ensure? #f) "/inferiors"))) +(define (channel-full-commit channel) + "Return the commit designated by CHANNEL as quickly as possible. If +CHANNEL's 'commit' field is a full SHA1, return it as-is; if it's a SHA1 +prefix, resolve it; and if 'commit' is unset, fetch CHANNEL's branch tip." + (let ((commit (channel-commit channel)) + (branch (channel-branch channel))) + (if (and commit (= (string-length commit) 40)) + commit + (let* ((ref (if commit `(commit . ,commit) `(branch . ,branch))) + (cache commit relation + (update-cached-checkout (channel-url channel) + #:ref ref + #:check-out? #f))) + commit)))) + (define* (cached-channel-instance store channels #:key @@ -701,15 +718,16 @@ failing when GUIX is too old and lacks the 'guix repl' command." The directory is a subdirectory of CACHE-DIRECTORY, where entries can be reclaimed after TTL seconds. This procedure opens a new connection to the build daemon. AUTHENTICATE? determines whether CHANNELS are authenticated." - (define instances - (latest-channel-instances store channels - #:authenticate? authenticate?)) + (define commits + ;; Since computing the instances of CHANNELS is I/O-intensive, use a + ;; cheaper way to get the commit list of CHANNELS. This limits overhead + ;; to the minimum in case of a cache hit. + (map channel-full-commit channels)) (define key (bytevector->base32-string (sha256 - (string->utf8 - (string-concatenate (map channel-instance-commit instances)))))) + (string->utf8 (string-concatenate commits))))) (define cached (string-append cache-directory "/" key)) @@ -737,8 +755,12 @@ determines whether CHANNELS are authenticated." (if (file-exists? cached) cached (run-with-store store - (mlet %store-monad ((profile - (channel-instances->derivation instances))) + (mlet* %store-monad ((instances + -> (latest-channel-instances store channels + #:authenticate? + authenticate?)) + (profile + (channel-instances->derivation instances))) (mbegin %store-monad (show-what-to-build* (list profile)) (built-derivations (list profile)) -- cgit v1.2.3