amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

inferior: Speed up 'cached-channel-instance' for cache hits.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2021-01-28 22:48:21 +01:00
parent d7db38341a
commit 7cfd789150
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 30 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

38
guix/inferior.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -40,6 +40,7 @@
#:use-module (guix search-paths) #:use-module (guix search-paths)
#:use-module (guix profiles) #:use-module (guix profiles)
#:use-module (guix channels) #:use-module (guix channels)
#:use-module ((guix git) #:select (update-cached-checkout))
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix derivations) #:use-module (guix derivations)
@ -51,6 +52,7 @@
#:autoload (guix build utils) (mkdir-p) #:autoload (guix build utils) (mkdir-p)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-71)
#:autoload (ice-9 ftw) (scandir) #:autoload (ice-9 ftw) (scandir)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 popen) #: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) (make-parameter (string-append (cache-directory #:ensure? #f)
"/inferiors"))) "/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 (define* (cached-channel-instance store
channels channels
#:key #: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. 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? This procedure opens a new connection to the build daemon. AUTHENTICATE?
determines whether CHANNELS are authenticated." determines whether CHANNELS are authenticated."
(define instances (define commits
(latest-channel-instances store channels ;; Since computing the instances of CHANNELS is I/O-intensive, use a
#:authenticate? authenticate?)) ;; 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 (define key
(bytevector->base32-string (bytevector->base32-string
(sha256 (sha256
(string->utf8 (string->utf8 (string-concatenate commits)))))
(string-concatenate (map channel-instance-commit instances))))))
(define cached (define cached
(string-append cache-directory "/" key)) (string-append cache-directory "/" key))
@ -737,8 +755,12 @@ determines whether CHANNELS are authenticated."
(if (file-exists? cached) (if (file-exists? cached)
cached cached
(run-with-store store (run-with-store store
(mlet %store-monad ((profile (mlet* %store-monad ((instances
(channel-instances->derivation instances))) -> (latest-channel-instances store channels
#:authenticate?
authenticate?))
(profile
(channel-instances->derivation instances)))
(mbegin %store-monad (mbegin %store-monad
(show-what-to-build* (list profile)) (show-what-to-build* (list profile))
(built-derivations (list profile)) (built-derivations (list profile))