* [bug#50384] [PATCH] Optimise search-patch (reducing I/O)
@ 2021-09-04 21:17 Maxime Devos
2021-09-04 21:47 ` Ludovic Courtès
` (2 more replies)
0 siblings, 3 replies; 16+ messages in thread
From: Maxime Devos @ 2021-09-04 21:17 UTC (permalink / raw)
To: 50384
[-- Attachment #1.1: Type: text/plain, Size: 4791 bytes --]
Hi guix!
The attached patch series optimises the G-exp compiler for
local-file, by avoiding interning the file if it's already
in the store, but only if the hash is known in advance.
To take advantage of this, 'search-patch' has been modified
to compute the hash at expansion time.
The cost of this optimisation is a little additional
complexity, and computing derivations theoretically becomes
a little more expensive when the patch isn't already in
the store (1 call to 'stat' per non-yet-interned patch).
If you want to test this patch series for performance,
do _not_ run ./pre-inst-env guix, instead use
"guix pull --url=$PWD --branch=...", because the guix
from the checkout performs more 'lstat' calls than
an ‘user’ guix from "guix pull".
I'll show the patch series decreases the number of syscalls
below, using the 'strace' command. Use 'strace -c' to gather
some statistics:
# Run it twice for a hot cache. Ignore the output of the first run.
$ strace -c ./the-optimised-guix/bin/guix build -d pigx --no-grafts
$ strace -c ./the-optimised-guix/bin/guix build -d pigx --no-grafts
#
$ strace -c guix build -d pigx --no-grafts
$ strace -c guix build -d pigx --no-grafts
I've selected some syscalls from the output that seemed relevant
and formatted the call count in a table
optimised unoptimised result of optimisation:
stat 3865 3712 + 4.1%
lstat 119 321 -62.9%
fstat 59 59 unchanged
read 17303 17688 - 2.2%
write 6741 6767 - 1.9%
openat 885 1076 -17.8%
readlink 14 16 -12.5%
-------
total 28886 32539 -11.2%
Almost all syscalls are now called less (-11.2% in total),
which is good. The exception is 'stat'.
Because 'search-path' is now being called less often
(only when the patch isn't in the store), the number
of 'stat' calls decreases. However, 'local-file-compiler'
now calls 'stat' more (one or two times per patch). I think
it's worth it though, because:
(1) the second 'stat' is on the same file as the first 'stat',
so presumably the kernel has cached the result, so no need
to wait for I/O to complete the second time (there's a context
switch though). So ignoring the context switch cost,
there are only ‘effectively’ +2.1% extra calls to 'stat'.
(2) the total decrease of -11.2% syscalls
Now, what about the actual "time to derivation"?
First, let's time "guix build -d pigx --no-grafts" to get some raw numbers
on guix before the optimisation:
time guix build -d pigx --no-grafts
# repeated four times, first output is discarded
# to eliminate hot/cold cache differences
/gnu/store/03vmq94ckxfx6c4rc9zh745yy63n5i5m-pigx-0.0.3.drv
real 0m13,470s
user 0m13,526s
sys 0m0,573s
/gnu/store/03vmq94ckxfx6c4rc9zh745yy63n5i5m-pigx-0.0.3.drv
real 0m13,582s
user 0m13,639s
sys 0m0,568s
/gnu/store/03vmq94ckxfx6c4rc9zh745yy63n5i5m-pigx-0.0.3.drv
real 0m13,834s
user 0m13,901s
sys 0m0,556s
Average numbers:
real 0m13,629s
user 0m13,689s
sys 0m0,566s
After the optimisation:
time ./the-optimised-guix/bin/guix build -d pigx --no-grafts
/gnu/store/fq6x8d2vcm6sbjkimg7g8kcgb4c5xv1b-pigx-0.0.3.drv
real 0m14,150s
user 0m13,979s
sys 0m0,685s
/gnu/store/fq6x8d2vcm6sbjkimg7g8kcgb4c5xv1b-pigx-0.0.3.drv
real 0m13,781s
user 0m13,697s
sys 0m0,580s
/gnu/store/fq6x8d2vcm6sbjkimg7g8kcgb4c5xv1b-pigx-0.0.3.drv
real 0m14,247s
user 0m14,160s
sys 0m0,548s
The numbers are higher somehow after the optimisations?
Even the 'sys' time is higher, even though there are less syscalls?
I re-ran the time commands, and got a decrease in 'real' time this time.
/gnu/store/fq6x8d2vcm6sbjkimg7g8kcgb4c5xv1b-pigx-0.0.3.drv
real 0m13,304s
user 0m13,146s
sys 0m0,609s
/gnu/store/fq6x8d2vcm6sbjkimg7g8kcgb4c5xv1b-pigx-0.0.3.drv
real 0m12,132s
user 0m11,940s
sys 0m0,589s
/gnu/store/fq6x8d2vcm6sbjkimg7g8kcgb4c5xv1b-pigx-0.0.3.drv
real 0m13,716s
user 0m13,723s
sys 0m0,529s
The output of "time ..." seems inconclusive
(can possibly be attributed to things like CPU frequency changing?),
but the decrease in syscall counts seems quite nice to me.
Feel free to run your own tests!
Greetings,
Maxime.
[-- Attachment #1.2: 0001-build-self-Implement-basic-hash-algorithm.patch --]
[-- Type: text/x-patch, Size: 2299 bytes --]
From a8e24a5258aa05689bcafa70af071da5296f63a4 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 4 Sep 2021 20:09:03 +0200
Subject: [PATCH 1/6] build-self: Implement basic 'hash-algorithm'.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
The module (guix hash) used from 'search-patch' in a future
patch needs it to be properly defined when (guix hash) is being
compiled. 'search-patch' is used when the derivation of Guix is
being computed, so it is important to avoid the ‘wrong type to
apply: #<syntax-transformer hash-algorithm>’ error.
* build-aux/build-self.scm
(build-program)[fake-gcrypt-hash]: Define hash-algorithm for sha1
and sha256.
---
build-aux/build-self.scm | 13 +++++++++++--
1 file changed, 11 insertions(+), 2 deletions(-)
diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm
index 3a2d13cc09..2c13d9d530 100644
--- a/build-aux/build-self.scm
+++ b/build-aux/build-self.scm
@@ -259,8 +259,17 @@ interface (FFI) of Guile.")
(define fake-gcrypt-hash
;; Fake (gcrypt hash) module; see below.
(scheme-file "hash.scm"
- #~(define-module (gcrypt hash)
- #:export (sha1 sha256))))
+ #~(begin
+ (define-module (gcrypt hash)
+ #:export (sha1 sha256 hash-algorithm))
+ ;; Avoid ‘Wrong type to apply:
+ ;; #<syntax-transformer hash-algorithm>’ errors.
+ (define sha1)
+ (define sha256)
+ (define-syntax hash-algorithm
+ (syntax-rules (sha1 sha256)
+ ((_ sha1) 2)
+ ((_ sha256) 8))))))
(define fake-git
(scheme-file "git.scm" #~(define-module (git))))
base-commit: b4d132f98e03fae559db832e88897f1e166c4d47
prerequisite-patch-id: 91a26ba19372112a11a0eea2b066d2f63641deb1
prerequisite-patch-id: a535c1ae2a1fbf75d7ac9a3118ed23bd4fa03ecc
prerequisite-patch-id: 29eba0cede1c1e7153a7c7b9a58b33b67f693a13
prerequisite-patch-id: 8dd2234fa0f867081c6cf614c7a22b00022702b4
prerequisite-patch-id: 2fe0e5c67a37ef3f0e22813c9808eaeec83bb552
prerequisite-patch-id: 91514568f1ef4870ad7ed7b3f685f04703f9c090
--
2.33.0
[-- Attachment #1.3: 0002-guix-hash-Extract-file-hashing-procedures.patch --]
[-- Type: text/x-patch, Size: 5153 bytes --]
From 919a0375781ff0fab9e74dbafc9b1f8989808a3b Mon Sep 17 00:00:00 2001
From: Sarah Morgensen <iskarian@mgsn.dev>
Date: Sun, 15 Aug 2021 16:25:24 -0700
Subject: [PATCH 2/6] guix hash: Extract file hashing procedures.
* guix/scripts/hash.scm (guix-hash)[vcs-file?, file-hash]: Extract logic
to...
* guix/hash.scm: ...here. New file.
---
guix/hash.scm | 51 +++++++++++++++++++++++++++++++++++++++++++
guix/scripts/hash.scm | 29 ++++++------------------
2 files changed, 58 insertions(+), 22 deletions(-)
create mode 100644 guix/hash.scm
diff --git a/guix/hash.scm b/guix/hash.scm
new file mode 100644
index 0000000000..8c2ab8187f
--- /dev/null
+++ b/guix/hash.scm
@@ -0,0 +1,51 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix hash)
+ #:use-module (gcrypt hash)
+ #:use-module (guix serialization)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
+ #:export (vcs-file?
+ file-hash*))
+
+(define (vcs-file? file stat)
+ "Returns true if FILE is a version control system file."
+ (case (stat:type stat)
+ ((directory)
+ (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS")))
+ ((regular)
+ ;; Git sub-modules have a '.git' file that is a regular text file.
+ (string=? (basename file) ".git"))
+ (else
+ #f)))
+
+(define* (file-hash* file #:key
+ (algorithm (hash-algorithm sha256))
+ (recursive? #t)
+ (select? (negate vcs-file?)))
+ "Compute the hash of FILE with ALGORITHM. If RECURSIVE? is true, recurse
+into subdirectories of FILE, computing the combined hash of all files for
+which (SELECT? FILE STAT) returns true."
+ (if recursive?
+ (let-values (((port get-hash)
+ (open-hash-port algorithm)))
+ (write-file file port #:select? select?)
+ (force-output port)
+ (get-hash))
+ (file-hash algorithm file)))
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index b8622373cc..353ca30c2c 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,6 +24,7 @@
#:use-module (gcrypt hash)
#:use-module (guix serialization)
#:use-module (guix ui)
+ #:use-module (guix hash)
#:use-module (guix scripts)
#:use-module (guix base16)
#:use-module (guix base32)
@@ -125,16 +127,6 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
(parse-command-line args %options (list %default-options)
#:build-options? #f))
- (define (vcs-file? file stat)
- (case (stat:type stat)
- ((directory)
- (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS")))
- ((regular)
- ;; Git sub-modules have a '.git' file that is a regular text file.
- (string=? (basename file) ".git"))
- (else
- #f)))
-
(let* ((opts (parse-options))
(args (filter-map (match-lambda
(('argument . value)
@@ -150,18 +142,11 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
;; Compute the hash of FILE.
;; Catch and gracefully report possible '&nar-error' conditions.
(with-error-handling
- (if (assoc-ref opts 'recursive?)
- (let-values (((port get-hash)
- (open-hash-port (assoc-ref opts 'hash-algorithm))))
- (write-file file port #:select? select?)
- (force-output port)
- (get-hash))
- (match file
- ("-" (port-hash (assoc-ref opts 'hash-algorithm)
- (current-input-port)))
- (_ (call-with-input-file file
- (cute port-hash (assoc-ref opts 'hash-algorithm)
- <>)))))))
+ (match file
+ ("-" (port-hash (assoc-ref opts 'hash-algorithm)
+ (current-input-port)))
+ (_ (file-hash* #:algorithm (assoc-ref opts 'hash-algorithm)
+ #:recursive? (assoc-ref opts 'recursive?))))))
(match args
((file)
--
2.33.0
[-- Attachment #1.4: 0003-gexp-Allow-computing-the-hash-of-the-local-file-in-a.patch --]
[-- Type: text/x-patch, Size: 3314 bytes --]
From cc54e1c5021119bfaba07849e83ea31f7099970e Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 4 Sep 2021 15:35:51 +0200
Subject: [PATCH 3/6] gexp: Allow computing the hash of the local file in
advance.
The new field is currently unused. The following patches will
populate and use the field to reduce the time-to-derivation
when the file is already interned in the store.
* guix/gexp.scm
(<local-file>): Add sha256 field.
(%local-file): Add sha256 argument for populating the field.
(local-file-compiler): Adjust 'match' expression.
---
guix/gexp.scm | 12 ++++++++----
1 file changed, 8 insertions(+), 4 deletions(-)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index f3d278b3e6..a633984688 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -419,13 +419,16 @@ Here TARGET is bound to the cross-compilation triplet or #f."
;; A local file name. FILE is the file name the user entered, which can be a
;; relative file name, and ABSOLUTE is a promise that computes its canonical
;; absolute file name. We keep it in a promise to compute it lazily and avoid
-;; repeated 'stat' calls.
+;; repeated 'stat' calls. Allow computing the hash of the file in advance,
+;; to avoid having to send the file to the daemon when it is already interned
+;; in the store.
(define-record-type <local-file>
- (%%local-file file absolute name recursive? select?)
+ (%%local-file file absolute name sha256 recursive? select?)
local-file?
(file local-file-file) ;string
(absolute %local-file-absolute-file-name) ;promise string
(name local-file-name) ;string
+ (sha256 local-file-sha256) ;sha256 bytevector | #f
(recursive? local-file-recursive?) ;Boolean
(select? local-file-select?)) ;string stat -> Boolean
@@ -434,6 +437,7 @@ Here TARGET is bound to the cross-compilation triplet or #f."
(define* (%local-file file promise #:optional (name (basename file))
#:key
(literal? #t) location
+ sha256
recursive? (select? true))
;; This intermediate procedure is part of our ABI, but the underlying
;; %%LOCAL-FILE is not.
@@ -441,7 +445,7 @@ Here TARGET is bound to the cross-compilation triplet or #f."
(warning (and=> location source-properties->location)
(G_ "resolving '~a' relative to current directory~%")
file))
- (%%local-file file promise name recursive? select?))
+ (%%local-file file promise name sha256 recursive? select?))
(define (absolute-file-name file directory)
"Return the canonical absolute file name for FILE, which lives in the
@@ -517,7 +521,7 @@ appears."
(define-gexp-compiler (local-file-compiler (file <local-file>) system target)
;; "Compile" FILE by adding it to the store.
(match file
- (($ <local-file> file (= force absolute) name recursive? select?)
+ (($ <local-file> file (= force absolute) name sha256 recursive? select?)
;; Canonicalize FILE so that if it's a symlink, it is resolved. Failing
;; to do that, when RECURSIVE? is #t, we could end up creating a dangling
;; symlink in the store, and when RECURSIVE? is #f 'add-to-store' would
--
2.33.0
[-- Attachment #1.5: 0004-gexp-Allow-overriding-the-absolute-file-name.patch --]
[-- Type: text/x-patch, Size: 2450 bytes --]
From 1937edd906b817dd15648fa682d55d3b3f779e45 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 4 Sep 2021 16:25:22 +0200
Subject: [PATCH 4/6] gexp: Allow overriding the absolute file name.
This will be used by the next patch to implement search-patch in
terms of local-file.
* guix/gexp.scm
(precanonicalized-file-name): New macro.
(local-file): Use the absolute file name from precanonicalized-file-name
when available.
---
guix/gexp.scm | 12 +++++++++++-
1 file changed, 11 insertions(+), 1 deletion(-)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index a633984688..c69e4aa299 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -51,6 +51,7 @@
gexp-input-output
gexp-input-native?
+ precanonicalized-file-name
assume-valid-file-name
local-file
local-file?
@@ -463,6 +464,12 @@ the given file name is valid, even if it's not a string literal, and thus not
warn about it."
file)
+(define-syntax-rule (precanonicalized-file-name file absolute)
+ "This is a syntactic keyword to tell 'local-file' that it can assume that
+the given file name FILE has ABSOLUTE as absolute file name and 'local-file'
+does not need to compute the absolute file name by itself."
+ absolute)
+
(define-syntax local-file
(lambda (s)
"Return an object representing local file FILE to add to the store; this
@@ -481,7 +488,7 @@ where FILE is the entry's absolute file name and STAT is the result of
This is the declarative counterpart of the 'interned-file' monadic procedure.
It is implemented as a macro to capture the current source directory where it
appears."
- (syntax-case s (assume-valid-file-name)
+ (syntax-case s (assume-valid-file-name precanonicalized-file-name)
((_ file rest ...)
(string? (syntax->datum #'file))
;; FILE is a literal, so resolve it relative to the source directory.
@@ -495,6 +502,9 @@ appears."
#'(%local-file file
(delay (absolute-file-name file (getcwd)))
rest ...))
+ ((_ (precanonicalized-file-name file absolute) rest ...)
+ ;; Use the given file name ABSOLUTE as absolute file name.
+ #'(%local-file file (delay absolute) rest ...))
((_ file rest ...)
;; Resolve FILE relative to the current directory.
(with-syntax ((location (datum->syntax s (syntax-source s))))
--
2.33.0
[-- Attachment #1.6: 0005-packages-Compute-the-hash-of-patches-in-advance-when.patch --]
[-- Type: text/x-patch, Size: 9373 bytes --]
From e3b14fdf63e78a504a4f6e8a6ed85d5f8b08acb7 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 4 Sep 2021 17:25:58 +0200
Subject: [PATCH 5/6] packages: Compute the hash of patches in advance when
possible.
* gnu/packages.scm
(search-patch): Rename to ...
(%search-patch): ... this.
(try-search-patch): New procedure, extracted from ...
(%search-patch): ... this procedure.
(%local-patch-file): New procedure.
(true): New procedure.
(search-patch): New macro, behaving like %search-patch, but computing the
hash at expansion time when possible.
* gnu/packages/chromium.scm
(%guix-patches): Use search-patches instead of local-file +
assume-valid-file-name + search-patch.
* gnu/packages/gnuzilla.scm
(icecat-source)[gnuzilla-fixes-patch]: Use search-patch instead of
local-file + assule-valid-file-name + search-patch.
(icecat-source)[makeicecat-patch]: Likewise.
* gnu/packages/embedded.scm
(gcc-arm-none-eabi-4.9)[source]{patches}: Expect patches to be
local-file objects instead of strings.
of strings.
* guix/lint.scm (check-patch-file-names): Allow local-file objects.
---
gnu/packages.scm | 42 +++++++++++++++++++++++++++++++++++++--
gnu/packages/chromium.scm | 4 +---
gnu/packages/embedded.scm | 3 ++-
gnu/packages/gnuzilla.scm | 8 ++------
guix/lint.scm | 28 ++++++++++++++++----------
5 files changed, 62 insertions(+), 23 deletions(-)
diff --git a/gnu/packages.scm b/gnu/packages.scm
index ccfc83dd11..f5552e5a9b 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,11 +22,13 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages)
+ #:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix diagnostics)
#:use-module (guix discovery)
+ #:use-module (guix hash)
#:use-module (guix memoization)
#:use-module ((guix build utils)
#:select ((package-name->name+version
@@ -90,12 +93,47 @@
"Search the auxiliary FILE-NAME. Return #f if not found."
(search-path (%auxiliary-files-path) file-name))
-(define (search-patch file-name)
+(define (try-search-patch file-name)
+ "Search the patch FILE-NAME. Return #f if not found."
+ (search-path (%patch-path) file-name))
+
+(define (%search-patch file-name)
"Search the patch FILE-NAME. Raise an error if not found."
- (or (search-path (%patch-path) file-name)
+ (or (try-search-patch file-name)
(raise (formatted-message (G_ "~a: patch not found")
file-name))))
+(define (%local-patch-file file-name hash)
+ "Search the patch FILE-NAME, which is known to have HASH."
+ (local-file (precanonicalized-file-name file-name (%search-patch file-name))
+ #:sha256 hash #:recursive? #t))
+
+(define true (const #t))
+
+(define-syntax search-patch
+ (lambda (s)
+ "Search the patch FILE-NAME and compute its hash at expansion time
+if possible. Return #f if not found."
+ (syntax-case s ()
+ ((_ file-name)
+ (string? (syntax->datum #'file-name))
+ ;; FILE-NAME is a constant string, so the hash can be computed
+ ;; in advance.
+ (let ((patch (try-search-patch (syntax->datum #'file-name))))
+ (if patch
+ #`(%local-patch-file file-name #,(file-hash* patch #:select? true))
+ (begin
+ (warning (source-properties->location
+ (syntax-source #'file-name))
+ (G_ "~a: patch not found at expansion time")
+ (syntax->datum #'ile-name))
+ #'(%search-patch file-name)))))
+ ;; FILE-NAME is variable, so the hash cannot be pre-computed.
+ ((_ file-name) #'(%search-patch file-name))
+ ;; search-patch is being used used in a construct like
+ ;; (map search-patch ...).
+ (id (identifier? #'id) #'%search-patch))))
+
(define-syntax-rule (search-patches file-name ...)
"Return the list of absolute file names corresponding to each
FILE-NAME found in %PATCH-PATH."
diff --git a/gnu/packages/chromium.scm b/gnu/packages/chromium.scm
index 26ae1e2550..cf419cf41b 100644
--- a/gnu/packages/chromium.scm
+++ b/gnu/packages/chromium.scm
@@ -351,9 +351,7 @@
"0wbcbjzh5ak4nciahqw4yvxc4x8ik4x0iz9h4kfy0m011sxzy174"))))
(define %guix-patches
- (list (local-file
- (assume-valid-file-name
- (search-patch "ungoogled-chromium-extension-search-path.patch")))))
+ (search-patches "ungoogled-chromium-extension-search-path.patch"))
;; This is a source 'snippet' that does the following:
;; *) Applies various patches for unbundling purposes and libstdc++ compatibility.
diff --git a/gnu/packages/embedded.scm b/gnu/packages/embedded.scm
index f388c11c3d..826f5655c3 100644
--- a/gnu/packages/embedded.scm
+++ b/gnu/packages/embedded.scm
@@ -30,6 +30,7 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix svn-download)
+ #:use-module (guix gexp)
#:use-module (guix git-download)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system cmake)
@@ -91,7 +92,7 @@
;; Remove the one patch that doesn't apply to this 4.9 snapshot (the
;; patch is for 4.9.4 and later but this svn snapshot is older).
(patches (remove (lambda (patch)
- (string=? (basename patch)
+ (string=? (local-file-name patch)
"gcc-arm-bug-71399.patch"))
(origin-patches (package-source xgcc))))))
(native-inputs
diff --git a/gnu/packages/gnuzilla.scm b/gnu/packages/gnuzilla.scm
index 576bc2586f..be674dce8f 100644
--- a/gnu/packages/gnuzilla.scm
+++ b/gnu/packages/gnuzilla.scm
@@ -736,14 +736,10 @@ from forcing GEXP-PROMISE."
(base32
"00ws3540x5whpicc5fx4k949ff73cqvajz6jp13ahn49wqdads47"))))
- ;; 'search-patch' returns either a valid file name or #f, so wrap it
- ;; in 'assume-valid-file-name' to avoid 'local-file' warnings.
(gnuzilla-fixes-patch
- (local-file (assume-valid-file-name
- (search-patch "icecat-use-older-reveal-hidden-html.patch"))))
+ (search-patch "icecat-use-older-reveal-hidden-html.patch"))
(makeicecat-patch
- (local-file (assume-valid-file-name
- (search-patch "icecat-makeicecat.patch")))))
+ (search-patch "icecat-makeicecat.patch")))
(origin
(method computed-origin-method)
diff --git a/guix/lint.scm b/guix/lint.scm
index 3a7f3be327..b0a2fbc327 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -46,6 +46,7 @@
gexp->approximate-sexp))
#:use-module (guix licenses)
#:use-module (guix records)
+ #:use-module (guix gexp)
#:use-module (guix grafts)
#:use-module (guix upstream)
#:use-module (guix utils)
@@ -928,6 +929,8 @@ patch could not be found."
(starts-with-package-name? (basename patch)))
((? origin? patch)
(starts-with-package-name? (origin-actual-file-name patch)))
+ ((? local-file? patch)
+ (starts-with-package-name? (local-file-name patch)))
(_ #f)) ;must be some other file-like object
patches)
'()
@@ -941,19 +944,22 @@ patch could not be found."
(let ((prefix (string-length (%distro-directory)))
(margin (string-length "guix-2.0.0rc3-10000-1234567890/"))
(max 99))
+ (define (test-patch-name file-name)
+ (if (> (+ margin (if (string-prefix? (%distro-directory) file-name)
+ (- (string-length file-name) prefix)
+ (string-length file-name)))
+ max)
+ (make-warning
+ package
+ (G_ "~a: file name is too long")
+ (list (basename file-name))
+ #:field 'patch-file-names)
+ #f))
(filter-map (match-lambda
((? string? patch)
- (if (> (+ margin (if (string-prefix? (%distro-directory)
- patch)
- (- (string-length patch) prefix)
- (string-length patch)))
- max)
- (make-warning
- package
- (G_ "~a: file name is too long")
- (list (basename patch))
- #:field 'patch-file-names)
- #f))
+ (test-patch-name patch))
+ ((? local-file? patch)
+ (test-patch-name (local-file-absolute-file-name patch)))
(_ #f))
patches)))))
--
2.33.0
[-- Attachment #1.7: 0006-gexp-Do-not-intern-if-the-file-is-already-in-the-sto.patch --]
[-- Type: text/x-patch, Size: 3059 bytes --]
From 0fc54bdd9ccc9729fff54f5935a552e5e608a1d0 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 4 Sep 2021 18:10:32 +0200
Subject: [PATCH 6/6] gexp: Do not intern if the file is already in the store.
* guix/gexp.scm (local-file-compiler): When the file is already in the
store, re-use the fixed output path instead of interning the file
again.
---
guix/gexp.scm | 38 +++++++++++++++++++++++++++++++-------
1 file changed, 31 insertions(+), 7 deletions(-)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index c69e4aa299..da1e918801 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -531,13 +531,37 @@ appears."
(define-gexp-compiler (local-file-compiler (file <local-file>) system target)
;; "Compile" FILE by adding it to the store.
(match file
- (($ <local-file> file (= force absolute) name sha256 recursive? select?)
- ;; Canonicalize FILE so that if it's a symlink, it is resolved. Failing
- ;; to do that, when RECURSIVE? is #t, we could end up creating a dangling
- ;; symlink in the store, and when RECURSIVE? is #f 'add-to-store' would
- ;; just throw an error, both of which are inconvenient.
- (interned-file absolute name
- #:recursive? recursive? #:select? select?))))
+ ;; Delay computing the absolute file name until 'intern', as this
+ ;; might be a relatively expensive computation (e.g. if search-patch
+ ;; is used), especially on a spinning disk.
+ (($ <local-file> file absolute-promise name sha256 recursive? select?)
+ (let ()
+ (define (intern)
+ ;; Canonicalize FILE so that if it's a symlink, it is resolved.
+ ;; Failing to do that, when RECURSIVE? is #t, we could end up creating
+ ;; a dangling symlink in the store, and when RECURSIVE? is #f
+ ;; 'add-to-store' would just throw an error, both of which are
+ ;; inconvenient.
+ (interned-file (force absolute-promise) name
+ #:recursive? recursive? #:select? select?))
+ (if sha256
+ (let ((path (fixed-output-path name sha256 #:recursive? recursive?)))
+ ;; If the hash is known in advance and the store already has the
+ ;; item, there is no need to intern the file.
+ (if (file-exists? path)
+ (mbegin %store-monad
+ ;; Tell the GC that PATH will be used, such that it won't
+ ;; be deleted.
+ ((store-lift add-temp-root) path)
+ ;; The GC could have deleted the item before add-temp-root
+ ;; completed, so check again if PATH exists.
+ (if (file-exists? path)
+ (return path)
+ ;; If it has been removed, fall-back interning.
+ (intern)))
+ ;; If PATH does not yet exist, fall back to interning.
+ (intern)))
+ (intern))))))
(define-record-type <plain-file>
(%plain-file name content references)
--
2.33.0
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply related [flat|nested] 16+ messages in thread
* [bug#50384] [PATCH] Optimise search-patch (reducing I/O)
2021-09-04 21:17 [bug#50384] [PATCH] Optimise search-patch (reducing I/O) Maxime Devos
@ 2021-09-04 21:47 ` Ludovic Courtès
2021-09-04 22:04 ` Ludovic Courtès
2021-09-09 20:25 ` [bug#50384] [PATCH v3] " Maxime Devos
2 siblings, 0 replies; 16+ messages in thread
From: Ludovic Courtès @ 2021-09-04 21:47 UTC (permalink / raw)
To: Maxime Devos; +Cc: 50384
Hi!
Some initial comments…
Maxime Devos <maximedevos@telenet.be> skribis:
> +++ b/guix/gexp.scm
> @@ -531,13 +531,37 @@ appears."
> (define-gexp-compiler (local-file-compiler (file <local-file>) system target)
> ;; "Compile" FILE by adding it to the store.
> (match file
> - (($ <local-file> file (= force absolute) name sha256 recursive? select?)
> - ;; Canonicalize FILE so that if it's a symlink, it is resolved. Failing
> - ;; to do that, when RECURSIVE? is #t, we could end up creating a dangling
> - ;; symlink in the store, and when RECURSIVE? is #f 'add-to-store' would
> - ;; just throw an error, both of which are inconvenient.
> - (interned-file absolute name
> - #:recursive? recursive? #:select? select?))))
> + ;; Delay computing the absolute file name until 'intern', as this
> + ;; might be a relatively expensive computation (e.g. if search-patch
> + ;; is used), especially on a spinning disk.
> + (($ <local-file> file absolute-promise name sha256 recursive? select?)
> + (let ()
> + (define (intern)
> + ;; Canonicalize FILE so that if it's a symlink, it is resolved.
> + ;; Failing to do that, when RECURSIVE? is #t, we could end up creating
> + ;; a dangling symlink in the store, and when RECURSIVE? is #f
> + ;; 'add-to-store' would just throw an error, both of which are
> + ;; inconvenient.
> + (interned-file (force absolute-promise) name
> + #:recursive? recursive? #:select? select?))
> + (if sha256
> + (let ((path (fixed-output-path name sha256 #:recursive? recursive?)))
> + ;; If the hash is known in advance and the store already has the
> + ;; item, there is no need to intern the file.
> + (if (file-exists? path)
> + (mbegin %store-monad
> + ;; Tell the GC that PATH will be used, such that it won't
> + ;; be deleted.
> + ((store-lift add-temp-root) path)
> + ;; The GC could have deleted the item before add-temp-root
> + ;; completed, so check again if PATH exists.
> + (if (file-exists? path)
> + (return path)
> + ;; If it has been removed, fall-back interning.
> + (intern)))
> + ;; If PATH does not yet exist, fall back to interning.
> + (intern)))
> + (intern))))))
‘file-exists?’ won’t work when talking to a remote store (e.g.,
GUIX_DAEMON_SOCKET=ssh://…).
‘add-temp-root’ doesn’t throw if the given store item does not exist.
So it could be written like this:
(if sha256
(mbegin %store-monad
(add-temp-root* item)
(if (valid-path?* item)
(return item)
(intern)))
(intern))
But then, we’d add one RPC for every ‘add-to-store’ RPC corresponding to
a patch (you can set “GUIX_PROFILING=rpc” to see the numbers), which is
not great.
Ludo’.
^ permalink raw reply [flat|nested] 16+ messages in thread
* [bug#50384] [PATCH] Optimise search-patch (reducing I/O)
2021-09-04 21:17 [bug#50384] [PATCH] Optimise search-patch (reducing I/O) Maxime Devos
2021-09-04 21:47 ` Ludovic Courtès
@ 2021-09-04 22:04 ` Ludovic Courtès
2021-09-05 19:48 ` [bug#50384] [PATCH v2] " Maxime Devos
2021-09-09 20:25 ` [bug#50384] [PATCH v3] " Maxime Devos
2 siblings, 1 reply; 16+ messages in thread
From: Ludovic Courtès @ 2021-09-04 22:04 UTC (permalink / raw)
To: Maxime Devos; +Cc: 50384
Maxime Devos <maximedevos@telenet.be> skribis:
> +(define-syntax search-patch
> + (lambda (s)
> + "Search the patch FILE-NAME and compute its hash at expansion time
> +if possible. Return #f if not found."
> + (syntax-case s ()
> + ((_ file-name)
> + (string? (syntax->datum #'file-name))
> + ;; FILE-NAME is a constant string, so the hash can be computed
> + ;; in advance.
> + (let ((patch (try-search-patch (syntax->datum #'file-name))))
> + (if patch
> + #`(%local-patch-file file-name #,(file-hash* patch #:select? true))
> + (begin
> + (warning (source-properties->location
> + (syntax-source #'file-name))
> + (G_ "~a: patch not found at expansion time")
> + (syntax->datum #'ile-name))
> + #'(%search-patch file-name)))))
> + ;; FILE-NAME is variable, so the hash cannot be pre-computed.
> + ((_ file-name) #'(%search-patch file-name))
> + ;; search-patch is being used used in a construct like
> + ;; (map search-patch ...).
> + (id (identifier? #'id) #'%search-patch))))
It’s clever… but also a bit evil, in that it changes the semantics of
package files in a surprising way. Modifying foo.patch without
recompiling foo.scm would lead you to still use the old foo.patch, which
can be rather off-putting and error-prone IMO.
To address this, ‘local-file’ could store the inode/mtime + computed
store file name (rather than the SHA256). ‘local-file-compiler’ would
check whether the actual file has matching inode/mtime before returning
the computed store file name. Problem is that inode/mtime are
guaranteed to differ once you’ve run “make install”. :-/
Intuitively, I’d have imagined a cache populated at run time; it would
map, say, file name/inode/mtime to a store file name. ‘add-to-store’
(or some wrapper above it) would check the cache and return the store
file name directly, unless ‘valid-path?’ says it no longer exists.
Downside is that this would be a per-user cache and you’d still pay the
cost until it’s warm. Advantage is that you could easily tell whether
it’s stale.
Thoughts?
Ludo’.
^ permalink raw reply [flat|nested] 16+ messages in thread
* [bug#50384] [PATCH v2] Optimise search-patch (reducing I/O)
2021-09-04 22:04 ` Ludovic Courtès
@ 2021-09-05 19:48 ` Maxime Devos
2021-09-05 22:40 ` Maxime Devos
` (2 more replies)
0 siblings, 3 replies; 16+ messages in thread
From: Maxime Devos @ 2021-09-05 19:48 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 50384
[-- Attachment #1.1: Type: text/plain, Size: 9561 bytes --]
Ludovic Courtès schreef op zo 05-09-2021 om 00:04 [+0200]:
> Maxime Devos <maximedevos@telenet.be> skribis:
>
> > +(define-syntax search-patch
> > + (lambda (s)
> > + "Search the patch FILE-NAME and compute its hash at expansion time
> > +if possible. Return #f if not found."
> > + (syntax-case s ()
> > + ((_ file-name)
> > + (string? (syntax->datum #'file-name))
> > + ;; FILE-NAME is a constant string, so the hash can be computed
> > + ;; in advance.
> > + (let ((patch (try-search-patch (syntax->datum #'file-name))))
> > + (if patch
> > + #`(%local-patch-file file-name #,(file-hash* patch #:select? true))
> > + (begin
> > + (warning (source-properties->location
> > + (syntax-source #'file-name))
> > + (G_ "~a: patch not found at expansion time")
> > + (syntax->datum #'ile-name))
> > + #'(%search-patch file-name)))))
> > + ;; FILE-NAME is variable, so the hash cannot be pre-computed.
> > + ((_ file-name) #'(%search-patch file-name))
> > + ;; search-patch is being used used in a construct like
> > + ;; (map search-patch ...).
> > + (id (identifier? #'id) #'%search-patch))))
>
> It’s clever… but also a bit evil, in that it changes the semantics of
> package files in a surprising way. Modifying foo.patch without
> recompiling foo.scm would lead you to still use the old foo.patch, which
> can be rather off-putting and error-prone IMO.
I added two patches adding (limited) dependency tracking to compile-all.scm.
If a patch file is now modified or deleted, the corresponding package modules
will be recompiled. This should remove the ‘evilness’ I think.
> To address this, ‘local-file’ could store the inode/mtime + computed
> store file name (rather than the SHA256). ‘local-file-compiler’ would
> check whether the actual file has matching inode/mtime before returning
> the computed store file name. Problem is that inode/mtime are
> guaranteed to differ once you’ve run “make install”. :-/
An additional problem is that 'local-file-compiler' would have to 'stat'
the file even if it is already in the store, undoing the (fairly limited?)
performance gains of this patch series.
The dependency tracking avoids this.
> Intuitively, I’d have imagined a cache populated at run time; it would
> map, say, file name/inode/mtime to a store file name. ‘add-to-store’
> (or some wrapper above it) would check the cache and return the store
> file name directly, unless ‘valid-path?’ says it no longer exists.
> Downside is that this would be a per-user cache and you’d still pay the
> cost until it’s warm. Advantage is that you could easily tell whether
> it’s stale.
>
> Thoughts?
Intuitively, I'd have imagined doing as much as possible at compilation time.
The cost at compilation is only paid once (or, more correctly, at every
"guix pull"), while if you delay things until runtime, you need to check the
caches.
With this patch series (+ the two patches mentioned previously), the ‘cache’
is always fresh (though possibly not warm: the patch might not yet be in the
store).
Ludovic Courtès schreef op za 04-09-2021 om 23:47 [+0200]:
> Hi!
>
> Some initial comments…
>
> Maxime Devos <maximedevos@telenet.be> skribis:
>
> > +++ b/guix/gexp.scm
> > @@ -531,13 +531,37 @@ appears."
> > (define-gexp-compiler (local-file-compiler (file <local-file>) system target)
> > [...]
> > + (if sha256
> > + (let ((path (fixed-output-path name sha256 #:recursive? recursive?)))
> > + ;; If the hash is known in advance and the store already has the
> > + ;; item, there is no need to intern the file.
> > + (if (file-exists? path)
> > + (mbegin %store-monad
> > + ;; Tell the GC that PATH will be used, such that it won't
> > + ;; be deleted.
> > + ((store-lift add-temp-root) path)
> > + ;; The GC could have deleted the item before add-temp-root
> > + ;; completed, so check again if PATH exists.
> > + (if (file-exists? path)
> > + (return path)
> > + ;; If it has been removed, fall-back interning.
> > + (intern)))
> > + ;; If PATH does not yet exist, fall back to interning.
> > + (intern)))
> > + (intern))))))
>
> ‘file-exists?’ won’t work when talking to a remote store (e.g.,
> GUIX_DAEMON_SOCKET=ssh://…).
>
> ‘add-temp-root’ doesn’t throw if the given store item does not exist.
> So it could be written like this:
>
> (if sha256
> (mbegin %store-monad
> (add-temp-root* item)
> (if (valid-path?* item)
> (return item)
> (intern)))
> (intern))
Done in the v2.
> But then, we’d add one RPC for every ‘add-to-store’ RPC corresponding to
> a patch (you can set “GUIX_PROFILING=rpc” to see the numbers), which is
> not great.
>
> Ludo’.
Note that 'intern' is only called if the patch isn't yet in the store.
In practice, the patch is almost always already in the store. For example,
suppose I have a few packages in my profile. As the packages are in my
profile, they had to have their derivation computed at some point, so the
corresponding patches had to be interned.
If I now run "guix pull && guix package -u", when computing the derivation
of the updated profile, most required patches are already in the store,
because patches don't change often.
Likewise, if I run "guix environment guix" in one terminal, then in another,
then in yet another ... possibly for the first invocation, some patches need
to be interned, but for the other invocations, it's already in the store.
Because fixed-output-path is now called more often, I've added a patch
optimising (guix base32).
Let's compare the numbers again! This time, I've run
echo powersave |sudo tee /sys/devices/system/cpu/cpufreq/policy{0,1,2,3}/scaling_governor
to make sure the CPU frequency doesn't change. On a hot (disk) cache:
# After the patch series
time GUIX_PROFILING="rpc gc" ./the-optimised-guix/bin/guix build -d --no-grafts pigx
Remote procedure call summary: 5949 RPCs
built-in-builders ... 1
add-to-store ... 3
add-to-store/tree ... 26
add-temp-root ... 195
valid-path? ... 195
add-text-to-store ... 5529
Garbage collection statistics:
heap size: 93.85 MiB
allocated: 312.04 MiB
GC times: 17
time spent in GC: 3.34 seconds (25% of user time)
# averaged over three runs
real 0m14,035s
user 0m14,138s
sys 0m0,650s
# Before the patch series
time GUIX_PROFILING="rpc gc" ./the-unoptimised-guix/bin/guix build -d --no-grafts pigx
/gnu/store/fq6x8d2vcm6sbjkimg7g8kcgb4c5xv1b-pigx-0.0.3.drv
Remote procedure call summary: 5749 RPCs
built-in-builders ... 1
add-to-store/tree ... 26
add-to-store ... 193
add-text-to-store ... 5529
Garbage collection statistics:
heap size: 93.85 MiB
allocated: 325.24 MiB
GC times: 18
time spent in GC: 3.66 seconds (26% of user time)
real 0m13,700s
user 0m14,051s
sys 0m0,658s
So on a hot disk cache, there doesn't appear to be any improvement
(except for ‘time spent in GC’ -- presumably that's due to the optimisations
to guix/base32.scm).
What about a cold cache?
# After the patch series
sync && echo 3 | sudo tee /proc/sys/vm/drop_caches
./the-optimised-guix/bin/guix --help
time GUIX_PROFILING="rpc gc" ./the-optimised-guix/bin/guix build -d --no-grafts pigx
/gnu/store/fq6x8d2vcm6sbjkimg7g8kcgb4c5xv1b-pigx-0.0.3.drv
Remote procedure call summary: 5949 RPCs
built-in-builders ... 1
add-to-store ... 3
add-to-store/tree ... 26
add-temp-root ... 195
valid-path? ... 195
add-text-to-store ... 5529
Garbage collection statistics:
heap size: 93.85 MiB
allocated: 312.03 MiB
GC times: 17
time spent in GC: 3.37 seconds (23% of user time)
real 1m39,178s
user 0m14,557s
sys 0m0,990s
# Before the patch series
sync && echo 3 | sudo tee /proc/sys/vm/drop_caches
./the-unoptimised-guix/bin/guix --help
time GUIX_PROFILING="rpc gc" ./the-unoptimised-guix/bin/guix build -d --no-grafts pigx
Remote procedure call summary: 5749 RPCs
built-in-builders ... 1
add-to-store/tree ... 26
add-to-store ... 193
add-text-to-store ... 5529
Garbage collection statistics:
heap size: 93.85 MiB
allocated: 325.25 MiB
GC times: 18
time spent in GC: 3.63 seconds (25% of user time)
real 1m42,100s
user 0m14,690s
sys 0m1,127s
It seems that if the disk cache is cold, the time-to-derivation decreases
a little by this patch series. Much less than I had hoped for though; I'll
have to look into other areas for interesting performance gains ...
Greetings,
Maxime.
[-- Attachment #1.2: v2-0001-build-self-Implement-basic-hash-algorithm.patch --]
[-- Type: text/x-patch, Size: 1863 bytes --]
From a8e24a5258aa05689bcafa70af071da5296f63a4 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 4 Sep 2021 20:09:03 +0200
Subject: [PATCH v2 1/9] build-self: Implement basic 'hash-algorithm'.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
The module (guix hash) used from 'search-patch' in a future
patch needs it to be properly defined when (guix hash) is being
compiled. 'search-patch' is used when the derivation of Guix is
being computed, so it is important to avoid the ‘wrong type to
apply: #<syntax-transformer hash-algorithm>’ error.
* build-aux/build-self.scm
(build-program)[fake-gcrypt-hash]: Define hash-algorithm for sha1
and sha256.
---
build-aux/build-self.scm | 13 +++++++++++--
1 file changed, 11 insertions(+), 2 deletions(-)
diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm
index 3a2d13cc09..2c13d9d530 100644
--- a/build-aux/build-self.scm
+++ b/build-aux/build-self.scm
@@ -259,8 +259,17 @@ interface (FFI) of Guile.")
(define fake-gcrypt-hash
;; Fake (gcrypt hash) module; see below.
(scheme-file "hash.scm"
- #~(define-module (gcrypt hash)
- #:export (sha1 sha256))))
+ #~(begin
+ (define-module (gcrypt hash)
+ #:export (sha1 sha256 hash-algorithm))
+ ;; Avoid ‘Wrong type to apply:
+ ;; #<syntax-transformer hash-algorithm>’ errors.
+ (define sha1)
+ (define sha256)
+ (define-syntax hash-algorithm
+ (syntax-rules (sha1 sha256)
+ ((_ sha1) 2)
+ ((_ sha256) 8))))))
(define fake-git
(scheme-file "git.scm" #~(define-module (git))))
--
2.33.0
[-- Attachment #1.3: v2-0002-guix-hash-Extract-file-hashing-procedures.patch --]
[-- Type: text/x-patch, Size: 5554 bytes --]
From c38cae11df08a57b5a3f483601b6482c379a0749 Mon Sep 17 00:00:00 2001
From: Sarah Morgensen <iskarian@mgsn.dev>
Date: Sun, 15 Aug 2021 16:25:24 -0700
Subject: [PATCH v2 2/9] guix hash: Extract file hashing procedures.
* guix/scripts/hash.scm (guix-hash)[vcs-file?, file-hash]: Extract logic
to...
* guix/hash.scm: ...here. New file.
* Makefile.am (MODULES): Add new file.
---
Makefile.am | 1 +
guix/hash.scm | 51 +++++++++++++++++++++++++++++++++++++++++++
guix/scripts/hash.scm | 29 ++++++------------------
3 files changed, 59 insertions(+), 22 deletions(-)
create mode 100644 guix/hash.scm
diff --git a/Makefile.am b/Makefile.am
index 327d3f9961..8f8089c05c 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -107,6 +107,7 @@ MODULES = \
guix/narinfo.scm \
guix/derivations.scm \
guix/grafts.scm \
+ guix/hash.scm \
guix/repl.scm \
guix/transformations.scm \
guix/inferior.scm \
diff --git a/guix/hash.scm b/guix/hash.scm
new file mode 100644
index 0000000000..8c2ab8187f
--- /dev/null
+++ b/guix/hash.scm
@@ -0,0 +1,51 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix hash)
+ #:use-module (gcrypt hash)
+ #:use-module (guix serialization)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
+ #:export (vcs-file?
+ file-hash*))
+
+(define (vcs-file? file stat)
+ "Returns true if FILE is a version control system file."
+ (case (stat:type stat)
+ ((directory)
+ (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS")))
+ ((regular)
+ ;; Git sub-modules have a '.git' file that is a regular text file.
+ (string=? (basename file) ".git"))
+ (else
+ #f)))
+
+(define* (file-hash* file #:key
+ (algorithm (hash-algorithm sha256))
+ (recursive? #t)
+ (select? (negate vcs-file?)))
+ "Compute the hash of FILE with ALGORITHM. If RECURSIVE? is true, recurse
+into subdirectories of FILE, computing the combined hash of all files for
+which (SELECT? FILE STAT) returns true."
+ (if recursive?
+ (let-values (((port get-hash)
+ (open-hash-port algorithm)))
+ (write-file file port #:select? select?)
+ (force-output port)
+ (get-hash))
+ (file-hash algorithm file)))
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index b8622373cc..353ca30c2c 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,6 +24,7 @@
#:use-module (gcrypt hash)
#:use-module (guix serialization)
#:use-module (guix ui)
+ #:use-module (guix hash)
#:use-module (guix scripts)
#:use-module (guix base16)
#:use-module (guix base32)
@@ -125,16 +127,6 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
(parse-command-line args %options (list %default-options)
#:build-options? #f))
- (define (vcs-file? file stat)
- (case (stat:type stat)
- ((directory)
- (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS")))
- ((regular)
- ;; Git sub-modules have a '.git' file that is a regular text file.
- (string=? (basename file) ".git"))
- (else
- #f)))
-
(let* ((opts (parse-options))
(args (filter-map (match-lambda
(('argument . value)
@@ -150,18 +142,11 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
;; Compute the hash of FILE.
;; Catch and gracefully report possible '&nar-error' conditions.
(with-error-handling
- (if (assoc-ref opts 'recursive?)
- (let-values (((port get-hash)
- (open-hash-port (assoc-ref opts 'hash-algorithm))))
- (write-file file port #:select? select?)
- (force-output port)
- (get-hash))
- (match file
- ("-" (port-hash (assoc-ref opts 'hash-algorithm)
- (current-input-port)))
- (_ (call-with-input-file file
- (cute port-hash (assoc-ref opts 'hash-algorithm)
- <>)))))))
+ (match file
+ ("-" (port-hash (assoc-ref opts 'hash-algorithm)
+ (current-input-port)))
+ (_ (file-hash* #:algorithm (assoc-ref opts 'hash-algorithm)
+ #:recursive? (assoc-ref opts 'recursive?))))))
(match args
((file)
--
2.33.0
[-- Attachment #1.4: v2-0003-gexp-Allow-computing-the-hash-of-the-local-file-i.patch --]
[-- Type: text/x-patch, Size: 3317 bytes --]
From e5dc46800597023dfc1c9d53cc6e0db2f3999022 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 4 Sep 2021 15:35:51 +0200
Subject: [PATCH v2 3/9] gexp: Allow computing the hash of the local file in
advance.
The new field is currently unused. The following patches will
populate and use the field to reduce the time-to-derivation
when the file is already interned in the store.
* guix/gexp.scm
(<local-file>): Add sha256 field.
(%local-file): Add sha256 argument for populating the field.
(local-file-compiler): Adjust 'match' expression.
---
guix/gexp.scm | 12 ++++++++----
1 file changed, 8 insertions(+), 4 deletions(-)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index f3d278b3e6..a633984688 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -419,13 +419,16 @@ Here TARGET is bound to the cross-compilation triplet or #f."
;; A local file name. FILE is the file name the user entered, which can be a
;; relative file name, and ABSOLUTE is a promise that computes its canonical
;; absolute file name. We keep it in a promise to compute it lazily and avoid
-;; repeated 'stat' calls.
+;; repeated 'stat' calls. Allow computing the hash of the file in advance,
+;; to avoid having to send the file to the daemon when it is already interned
+;; in the store.
(define-record-type <local-file>
- (%%local-file file absolute name recursive? select?)
+ (%%local-file file absolute name sha256 recursive? select?)
local-file?
(file local-file-file) ;string
(absolute %local-file-absolute-file-name) ;promise string
(name local-file-name) ;string
+ (sha256 local-file-sha256) ;sha256 bytevector | #f
(recursive? local-file-recursive?) ;Boolean
(select? local-file-select?)) ;string stat -> Boolean
@@ -434,6 +437,7 @@ Here TARGET is bound to the cross-compilation triplet or #f."
(define* (%local-file file promise #:optional (name (basename file))
#:key
(literal? #t) location
+ sha256
recursive? (select? true))
;; This intermediate procedure is part of our ABI, but the underlying
;; %%LOCAL-FILE is not.
@@ -441,7 +445,7 @@ Here TARGET is bound to the cross-compilation triplet or #f."
(warning (and=> location source-properties->location)
(G_ "resolving '~a' relative to current directory~%")
file))
- (%%local-file file promise name recursive? select?))
+ (%%local-file file promise name sha256 recursive? select?))
(define (absolute-file-name file directory)
"Return the canonical absolute file name for FILE, which lives in the
@@ -517,7 +521,7 @@ appears."
(define-gexp-compiler (local-file-compiler (file <local-file>) system target)
;; "Compile" FILE by adding it to the store.
(match file
- (($ <local-file> file (= force absolute) name recursive? select?)
+ (($ <local-file> file (= force absolute) name sha256 recursive? select?)
;; Canonicalize FILE so that if it's a symlink, it is resolved. Failing
;; to do that, when RECURSIVE? is #t, we could end up creating a dangling
;; symlink in the store, and when RECURSIVE? is #f 'add-to-store' would
--
2.33.0
[-- Attachment #1.5: v2-0004-gexp-Allow-overriding-the-absolute-file-name.patch --]
[-- Type: text/x-patch, Size: 2453 bytes --]
From 8a64ac78767013e82f26cfddae951a8ef2e2caf8 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 4 Sep 2021 16:25:22 +0200
Subject: [PATCH v2 4/9] gexp: Allow overriding the absolute file name.
This will be used by the next patch to implement search-patch in
terms of local-file.
* guix/gexp.scm
(precanonicalized-file-name): New macro.
(local-file): Use the absolute file name from precanonicalized-file-name
when available.
---
guix/gexp.scm | 12 +++++++++++-
1 file changed, 11 insertions(+), 1 deletion(-)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index a633984688..c69e4aa299 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -51,6 +51,7 @@
gexp-input-output
gexp-input-native?
+ precanonicalized-file-name
assume-valid-file-name
local-file
local-file?
@@ -463,6 +464,12 @@ the given file name is valid, even if it's not a string literal, and thus not
warn about it."
file)
+(define-syntax-rule (precanonicalized-file-name file absolute)
+ "This is a syntactic keyword to tell 'local-file' that it can assume that
+the given file name FILE has ABSOLUTE as absolute file name and 'local-file'
+does not need to compute the absolute file name by itself."
+ absolute)
+
(define-syntax local-file
(lambda (s)
"Return an object representing local file FILE to add to the store; this
@@ -481,7 +488,7 @@ where FILE is the entry's absolute file name and STAT is the result of
This is the declarative counterpart of the 'interned-file' monadic procedure.
It is implemented as a macro to capture the current source directory where it
appears."
- (syntax-case s (assume-valid-file-name)
+ (syntax-case s (assume-valid-file-name precanonicalized-file-name)
((_ file rest ...)
(string? (syntax->datum #'file))
;; FILE is a literal, so resolve it relative to the source directory.
@@ -495,6 +502,9 @@ appears."
#'(%local-file file
(delay (absolute-file-name file (getcwd)))
rest ...))
+ ((_ (precanonicalized-file-name file absolute) rest ...)
+ ;; Use the given file name ABSOLUTE as absolute file name.
+ #'(%local-file file (delay absolute) rest ...))
((_ file rest ...)
;; Resolve FILE relative to the current directory.
(with-syntax ((location (datum->syntax s (syntax-source s))))
--
2.33.0
[-- Attachment #1.6: v2-0005-packages-Compute-the-hash-of-patches-in-advance-w.patch --]
[-- Type: text/x-patch, Size: 9376 bytes --]
From 737d7fb8e18c4e6e4db1d82455211ee5bdfae14d Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 4 Sep 2021 17:25:58 +0200
Subject: [PATCH v2 5/9] packages: Compute the hash of patches in advance when
possible.
* gnu/packages.scm
(search-patch): Rename to ...
(%search-patch): ... this.
(try-search-patch): New procedure, extracted from ...
(%search-patch): ... this procedure.
(%local-patch-file): New procedure.
(true): New procedure.
(search-patch): New macro, behaving like %search-patch, but computing the
hash at expansion time when possible.
* gnu/packages/chromium.scm
(%guix-patches): Use search-patches instead of local-file +
assume-valid-file-name + search-patch.
* gnu/packages/gnuzilla.scm
(icecat-source)[gnuzilla-fixes-patch]: Use search-patch instead of
local-file + assule-valid-file-name + search-patch.
(icecat-source)[makeicecat-patch]: Likewise.
* gnu/packages/embedded.scm
(gcc-arm-none-eabi-4.9)[source]{patches}: Expect patches to be
local-file objects instead of strings.
of strings.
* guix/lint.scm (check-patch-file-names): Allow local-file objects.
---
gnu/packages.scm | 42 +++++++++++++++++++++++++++++++++++++--
gnu/packages/chromium.scm | 4 +---
gnu/packages/embedded.scm | 3 ++-
gnu/packages/gnuzilla.scm | 8 ++------
guix/lint.scm | 28 ++++++++++++++++----------
5 files changed, 62 insertions(+), 23 deletions(-)
diff --git a/gnu/packages.scm b/gnu/packages.scm
index ccfc83dd11..f5552e5a9b 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,11 +22,13 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages)
+ #:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix diagnostics)
#:use-module (guix discovery)
+ #:use-module (guix hash)
#:use-module (guix memoization)
#:use-module ((guix build utils)
#:select ((package-name->name+version
@@ -90,12 +93,47 @@
"Search the auxiliary FILE-NAME. Return #f if not found."
(search-path (%auxiliary-files-path) file-name))
-(define (search-patch file-name)
+(define (try-search-patch file-name)
+ "Search the patch FILE-NAME. Return #f if not found."
+ (search-path (%patch-path) file-name))
+
+(define (%search-patch file-name)
"Search the patch FILE-NAME. Raise an error if not found."
- (or (search-path (%patch-path) file-name)
+ (or (try-search-patch file-name)
(raise (formatted-message (G_ "~a: patch not found")
file-name))))
+(define (%local-patch-file file-name hash)
+ "Search the patch FILE-NAME, which is known to have HASH."
+ (local-file (precanonicalized-file-name file-name (%search-patch file-name))
+ #:sha256 hash #:recursive? #t))
+
+(define true (const #t))
+
+(define-syntax search-patch
+ (lambda (s)
+ "Search the patch FILE-NAME and compute its hash at expansion time
+if possible. Return #f if not found."
+ (syntax-case s ()
+ ((_ file-name)
+ (string? (syntax->datum #'file-name))
+ ;; FILE-NAME is a constant string, so the hash can be computed
+ ;; in advance.
+ (let ((patch (try-search-patch (syntax->datum #'file-name))))
+ (if patch
+ #`(%local-patch-file file-name #,(file-hash* patch #:select? true))
+ (begin
+ (warning (source-properties->location
+ (syntax-source #'file-name))
+ (G_ "~a: patch not found at expansion time")
+ (syntax->datum #'ile-name))
+ #'(%search-patch file-name)))))
+ ;; FILE-NAME is variable, so the hash cannot be pre-computed.
+ ((_ file-name) #'(%search-patch file-name))
+ ;; search-patch is being used used in a construct like
+ ;; (map search-patch ...).
+ (id (identifier? #'id) #'%search-patch))))
+
(define-syntax-rule (search-patches file-name ...)
"Return the list of absolute file names corresponding to each
FILE-NAME found in %PATCH-PATH."
diff --git a/gnu/packages/chromium.scm b/gnu/packages/chromium.scm
index 26ae1e2550..cf419cf41b 100644
--- a/gnu/packages/chromium.scm
+++ b/gnu/packages/chromium.scm
@@ -351,9 +351,7 @@
"0wbcbjzh5ak4nciahqw4yvxc4x8ik4x0iz9h4kfy0m011sxzy174"))))
(define %guix-patches
- (list (local-file
- (assume-valid-file-name
- (search-patch "ungoogled-chromium-extension-search-path.patch")))))
+ (search-patches "ungoogled-chromium-extension-search-path.patch"))
;; This is a source 'snippet' that does the following:
;; *) Applies various patches for unbundling purposes and libstdc++ compatibility.
diff --git a/gnu/packages/embedded.scm b/gnu/packages/embedded.scm
index f388c11c3d..826f5655c3 100644
--- a/gnu/packages/embedded.scm
+++ b/gnu/packages/embedded.scm
@@ -30,6 +30,7 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix svn-download)
+ #:use-module (guix gexp)
#:use-module (guix git-download)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system cmake)
@@ -91,7 +92,7 @@
;; Remove the one patch that doesn't apply to this 4.9 snapshot (the
;; patch is for 4.9.4 and later but this svn snapshot is older).
(patches (remove (lambda (patch)
- (string=? (basename patch)
+ (string=? (local-file-name patch)
"gcc-arm-bug-71399.patch"))
(origin-patches (package-source xgcc))))))
(native-inputs
diff --git a/gnu/packages/gnuzilla.scm b/gnu/packages/gnuzilla.scm
index 576bc2586f..be674dce8f 100644
--- a/gnu/packages/gnuzilla.scm
+++ b/gnu/packages/gnuzilla.scm
@@ -736,14 +736,10 @@ from forcing GEXP-PROMISE."
(base32
"00ws3540x5whpicc5fx4k949ff73cqvajz6jp13ahn49wqdads47"))))
- ;; 'search-patch' returns either a valid file name or #f, so wrap it
- ;; in 'assume-valid-file-name' to avoid 'local-file' warnings.
(gnuzilla-fixes-patch
- (local-file (assume-valid-file-name
- (search-patch "icecat-use-older-reveal-hidden-html.patch"))))
+ (search-patch "icecat-use-older-reveal-hidden-html.patch"))
(makeicecat-patch
- (local-file (assume-valid-file-name
- (search-patch "icecat-makeicecat.patch")))))
+ (search-patch "icecat-makeicecat.patch")))
(origin
(method computed-origin-method)
diff --git a/guix/lint.scm b/guix/lint.scm
index 3a7f3be327..b0a2fbc327 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -46,6 +46,7 @@
gexp->approximate-sexp))
#:use-module (guix licenses)
#:use-module (guix records)
+ #:use-module (guix gexp)
#:use-module (guix grafts)
#:use-module (guix upstream)
#:use-module (guix utils)
@@ -928,6 +929,8 @@ patch could not be found."
(starts-with-package-name? (basename patch)))
((? origin? patch)
(starts-with-package-name? (origin-actual-file-name patch)))
+ ((? local-file? patch)
+ (starts-with-package-name? (local-file-name patch)))
(_ #f)) ;must be some other file-like object
patches)
'()
@@ -941,19 +944,22 @@ patch could not be found."
(let ((prefix (string-length (%distro-directory)))
(margin (string-length "guix-2.0.0rc3-10000-1234567890/"))
(max 99))
+ (define (test-patch-name file-name)
+ (if (> (+ margin (if (string-prefix? (%distro-directory) file-name)
+ (- (string-length file-name) prefix)
+ (string-length file-name)))
+ max)
+ (make-warning
+ package
+ (G_ "~a: file name is too long")
+ (list (basename file-name))
+ #:field 'patch-file-names)
+ #f))
(filter-map (match-lambda
((? string? patch)
- (if (> (+ margin (if (string-prefix? (%distro-directory)
- patch)
- (- (string-length patch) prefix)
- (string-length patch)))
- max)
- (make-warning
- package
- (G_ "~a: file name is too long")
- (list (basename patch))
- #:field 'patch-file-names)
- #f))
+ (test-patch-name patch))
+ ((? local-file? patch)
+ (test-patch-name (local-file-absolute-file-name patch)))
(_ #f))
patches)))))
--
2.33.0
[-- Attachment #1.7: v2-0006-compile-all-compile-Keep-track-of-dependencies-of.patch --]
[-- Type: text/x-patch, Size: 8457 bytes --]
From 40debc8910799df60bca343caca05f8c79f46421 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sun, 5 Sep 2021 14:02:30 +0200
Subject: [PATCH v2 6/9] compile-all,compile: Keep track of dependencies of
compiled modules.
This patch defines a 'notice-dependency' procedure.
Macros can use this procedure to inform build-aux/compile-all.scm
that a module needs to be recompiled when some file is updated.
* guix/build/compile.scm
(current-dependency-info, current-output-file): New parameters.
(notice-dependency): New procedure.
(compile-files)[build]: Set 'output-file'. Delete the old compiled file
if necessary. Remove old dependency information.
* build-aux/compile-all.scm: Populate current-dependency-info from a file.
Populate the file dependency-info.scm from the hash table.
(builddir): New variable.
(file-needs-compilation?): Check if the .go file is older than the
dependencies.
* .gitignore: Ignore dependency-info.scm.
---
.gitignore | 1 +
build-aux/compile-all.scm | 37 ++++++++++++++++++++++++++++----
guix/build/compile.scm | 45 ++++++++++++++++++++++++++++++++-------
3 files changed, 71 insertions(+), 12 deletions(-)
diff --git a/.gitignore b/.gitignore
index 88fe24586d..f24ea5fc3b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -154,3 +154,4 @@ tmp
/gnu/packages/bootstrap
/gnu/packages/aux-files/guile-guile-launcher.o
/guile
+/dependency-info.scm
diff --git a/build-aux/compile-all.scm b/build-aux/compile-all.scm
index 9ffbce43ad..02294073ed 100644
--- a/build-aux/compile-all.scm
+++ b/build-aux/compile-all.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -20,12 +21,15 @@
(use-modules (ice-9 format)
(ice-9 match)
(ice-9 threads)
+ (ice-9 hash-table)
(srfi srfi-1)
+ (srfi srfi-26)
(guix build compile)
(guix build utils))
(define host (getenv "host"))
(define srcdir (getenv "srcdir"))
+(define builddir (getcwd))
(define (relative-file file)
(if (string-prefix? (string-append srcdir "/") file)
@@ -41,10 +45,33 @@
(without-extension (string-drop-right relative 4)))
(string-append without-extension ".go")))
+;; Read dependency information from previous "make" runs.
+(current-dependency-info (make-hash-table))
+(if (file-exists? "dependency-info.scm")
+ (current-dependency-info
+ (alist->hash-table
+ (call-with-input-file "dependency-info.scm" read #:encoding "UTF-8")))
+ (current-dependency-info (make-hash-table)))
+
+(define (dump-dependency-info)
+ "Dump the current dependency information for the next \"make\" run."
+ (call-with-output-file "dependency-info.scm.new"
+ (lambda (port)
+ (display ";; This is auto-generated by build-aux/compile-all.scm,
+;; do not modify manually!
+" port)
+ (write (hash-map->list cons (current-dependency-info)) port))
+ #:encoding "UTF-8")
+ (rename-file "dependency-info.scm.new" "dependency-info.scm"))
+
(define (file-needs-compilation? file)
- (let ((go (scm->go file)))
+ (let* ((go (scm->go file))
+ (extra-dependencies
+ (hash-ref (current-dependency-info) (in-vicinity builddir go)
+ '())))
(or (not (file-exists? go))
- (file-mtime<? go file))))
+ (file-mtime<? go file)
+ (any (cut file-mtime<? go <>) extra-dependencies))))
(define* (parallel-job-count #:optional (flags (getenv "MAKEFLAGS")))
"Return the number of parallel jobs as determined by FLAGS, the flags passed
@@ -109,7 +136,7 @@ to 'make'."
(let* ((to-build (filter file-needs-compilation? files))
(processed (+ processed
(- (length files) (length to-build)))))
- (compile-files srcdir (getcwd) to-build
+ (compile-files srcdir builddir to-build
#:workers (parallel-job-count*)
#:host host
#:report-load (lambda (file total completed)
@@ -127,8 +154,10 @@ to 'make'."
(* 2 processed))
(* 2 grand-total))
(scm->go file))
- (force-output))))))
+ (force-output)))))
+ (dump-dependency-info))
(lambda _
+ (dump-dependency-info)
(primitive-exit 1))
(lambda args
;; Try to report the error in an intelligible way.
diff --git a/guix/build/compile.scm b/guix/build/compile.scm
index b86ec3b743..c259b27abf 100644
--- a/guix/build/compile.scm
+++ b/guix/build/compile.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -29,14 +30,27 @@
#:use-module (guix build utils)
#:use-module (language tree-il optimize)
#:use-module (language cps optimize)
- #:export (compile-files))
+ #:export (compile-files notice-dependency current-dependency-info))
;;; Commentary:
;;;
-;;; Support code to compile Guile code as efficiently as possible (with 2.2).
+;;; Support code to compile Guile code as efficiently as possible (with 2.2)
+;;; and keep track of the dependencies of compiled files.
;;;
;;; Code:
+(define current-dependency-info (make-parameter #f))
+(define current-output-file (make-parameter #f))
+
+(define (notice-dependency dependency)
+ "Add the file DEPENDENCY to the list of dependencies of the compiled file
+that is being computed, if any."
+ (define dependency-table (current-dependency-info))
+ (define output (current-output-file))
+ (when (and dependency-table output)
+ (hash-set! dependency-table output
+ (cons dependency (hash-ref dependency-table output '())))))
+
(define optimizations-for-level
(or (and=> (false-if-exception
(resolve-interface '(system base optimize)))
@@ -207,12 +221,27 @@ files are for HOST, a GNU triplet such as \"x86_64-linux-gnu\"."
;; Exit as soon as something goes wrong.
(exit-on-exception
file
- (let ((relative (relative-file source-directory file)))
- (compile-file file
- #:output-file (string-append build-directory "/"
- (scm->go relative))
- #:opts (append warning-options
- (optimization-options relative))))))
+ (let* ((relative (relative-file source-directory file))
+ (output-file (string-append build-directory "/"
+ (scm->go relative))))
+ (parameterize ((current-output-file output-file))
+ (when (current-dependency-info)
+ ;; If dependency information is being tracked, remove
+ ;; the old compiled file first. Otherwise, if recompiling
+ ;; the file due to an updated dependency causes an exception,
+ ;; the new dependency information won't include the compiled
+ ;; file and therefore the old compiled file would be considered
+ ;; up-to-date on the following "make" run.
+ (when (file-exists? output-file)
+ (delete-file output-file))
+ ;; Remove the old dependency information, otherwise
+ ;; the dependency information table will keep growing
+ ;; after each "make" run.
+ (hash-remove! (current-dependency-info) output-file))
+ (compile-file file
+ #:output-file output-file
+ #:opts (append warning-options
+ (optimization-options relative)))))))
(with-augmented-search-path %load-path source-directory
(with-augmented-search-path %load-compiled-path build-directory
--
2.33.0
[-- Attachment #1.8: v2-0007-packages-Add-patches-to-the-dependency-list-of-pa.patch --]
[-- Type: text/x-patch, Size: 1491 bytes --]
From 2bc29d443dc5d6096962da3d5a1028473462c431 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sun, 5 Sep 2021 17:15:08 +0200
Subject: [PATCH v2 7/9] packages: Add patches to the dependency list of
package modules.
* gnu/packages.scm (search-patch): Call 'notice-dependency' on
the patch file.
---
gnu/packages.scm | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
diff --git a/gnu/packages.scm b/gnu/packages.scm
index f5552e5a9b..39929ae022 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -34,6 +34,8 @@
#:select ((package-name->name+version
. hyphen-separated-name->name+version)
mkdir-p))
+ ;; only required at expansion time
+ #:autoload (guix build compile) (notice-dependency)
#:use-module (guix profiles)
#:use-module (guix describe)
#:use-module (guix deprecation)
@@ -121,7 +123,10 @@ if possible. Return #f if not found."
;; in advance.
(let ((patch (try-search-patch (syntax->datum #'file-name))))
(if patch
- #`(%local-patch-file file-name #,(file-hash* patch #:select? true))
+ (begin
+ (notice-dependency patch)
+ #`(%local-patch-file file-name
+ #,(file-hash* patch #:select? true)))
(begin
(warning (source-properties->location
(syntax-source #'file-name))
--
2.33.0
[-- Attachment #1.9: v2-0008-gexp-Do-not-intern-if-the-file-is-already-in-the-.patch --]
[-- Type: text/x-patch, Size: 3313 bytes --]
From b6907f76040fa524110a503848ed9b9d9b19dfaf Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 4 Sep 2021 18:10:32 +0200
Subject: [PATCH v2 8/9] gexp: Do not intern if the file is already in the
store.
* guix/gexp.scm (local-file-compiler): When the file is already in the
store, re-use the fixed output path instead of interning the file
again.
* guix/gexp.scm (add-temp-root*, valid-path?*): New procedures.
---
guix/gexp.scm | 41 ++++++++++++++++++++++++++++++++++-------
1 file changed, 34 insertions(+), 7 deletions(-)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index c69e4aa299..6a6d130110 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -528,16 +528,43 @@ appears."
'system-error' exception is raised if FILE could not be found."
(force (%local-file-absolute-file-name file)))
+(define add-temp-root* (store-lift add-temp-root))
+(define valid-path?* (store-lift valid-path?))
+
(define-gexp-compiler (local-file-compiler (file <local-file>) system target)
;; "Compile" FILE by adding it to the store.
(match file
- (($ <local-file> file (= force absolute) name sha256 recursive? select?)
- ;; Canonicalize FILE so that if it's a symlink, it is resolved. Failing
- ;; to do that, when RECURSIVE? is #t, we could end up creating a dangling
- ;; symlink in the store, and when RECURSIVE? is #f 'add-to-store' would
- ;; just throw an error, both of which are inconvenient.
- (interned-file absolute name
- #:recursive? recursive? #:select? select?))))
+ ;; Delay computing the absolute file name until 'intern', as this
+ ;; might be a relatively expensive computation (e.g. if search-patch
+ ;; is used), especially on a spinning disk.
+ (($ <local-file> file absolute-promise name sha256 recursive? select?)
+ (let ()
+ (define (intern)
+ ;; Canonicalize FILE so that if it's a symlink, it is resolved.
+ ;; Failing to do that, when RECURSIVE? is #t, we could end up creating
+ ;; a dangling symlink in the store, and when RECURSIVE? is #f
+ ;; 'add-to-store' would just throw an error, both of which are
+ ;; inconvenient.
+ (interned-file (force absolute-promise) name
+ #:recursive? recursive? #:select? select?))
+ ;; If the hash is known in advance and the store already has the
+ ;; item, there is no need to intern the file.
+ (if sha256
+ (let ((path (fixed-output-path name sha256 #:recursive? recursive?)))
+ (mbegin %store-monad
+ ;; Tell the GC that PATH will be used, such that it won't
+ ;; be deleted.
+ (add-temp-root* path)
+ ;; 'add-temp-root*' doesn't thow an error if the store item
+ ;; does not exist, so we need to check if PATH actually exists.
+ (mlet %store-monad
+ ((valid? (valid-path?* path)))
+ (if valid?
+ (return path)
+ ;; If it has been removed, fall-back interning.
+ (intern)))))
+ ;; If PATH does not yet exist, fall back to interning.
+ (intern))))))
(define-record-type <plain-file>
(%plain-file name content references)
--
2.33.0
[-- Attachment #1.10: v2-0009-base32-Reduce-GC-pressure-in-make-bytevector-base.patch --]
[-- Type: text/x-patch, Size: 2264 bytes --]
From ccbaa1a4b447c67f997a63494a82c8e2b905dccd Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sun, 5 Sep 2021 16:28:33 +0200
Subject: [PATCH v2 9/9] base32: Reduce GC pressure in
make-bytevector->base32-string.
The following code has been used to compare performance:
;; first 20 bytes of sha256 of #vu8(#xde #xad #xbe #xef)
(define bv #vu8(95 120 195 50 116 228 63 169 222 86 89 38 92 29 145 126 37 192 55 34))
,profile
(let loop ((n 0))
(when (< n #e1e6)
((@ (guix base32) bytevector->nix-base32-string) bv)
(loop (+ n 1))))
Before this change, the output was:
[...]
Sample count: 1140
Total time: 27.465560018 seconds (10.659331433 seconds in GC)
After this change, the output was:
[...]
Sample count: 957
Total time: 20.478847143 seconds (6.139721189 seconds in GC)
* guix/base32.scm
(make-bytevector->base32-string): Eliminate 'reverse', use mutation instead.
---
guix/base32.scm | 18 ++++++++++++------
1 file changed, 12 insertions(+), 6 deletions(-)
diff --git a/guix/base32.scm b/guix/base32.scm
index 49f191ba26..e76bf35ecc 100644
--- a/guix/base32.scm
+++ b/guix/base32.scm
@@ -141,12 +141,18 @@ the previous application or INIT."
(define (make-bytevector->base32-string quintet-fold base32-chars)
(lambda (bv)
"Return a base32 encoding of BV using BASE32-CHARS as the alphabet."
- (let ((chars (quintet-fold (lambda (q r)
- (cons (vector-ref base32-chars q)
- r))
- '()
- bv)))
- (list->string (reverse chars)))))
+ ;; Mutation can be avoided with 'reverse'. However, that would
+ ;; make this procedure about 30% slower due to the extra GC pressure.
+ (let* ((start (cons #f #f))
+ (end (quintet-fold (lambda (q r)
+ (define pair
+ (cons (vector-ref base32-chars q) #f))
+ (set-cdr! r pair)
+ pair)
+ start
+ bv)))
+ (set-cdr! end '())
+ (list->string (cdr start)))))
(define %nix-base32-chars
;; See `libutil/hash.cc'.
--
2.33.0
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply related [flat|nested] 16+ messages in thread
* [bug#50384] [PATCH v2] Optimise search-patch (reducing I/O)
2021-09-05 19:48 ` [bug#50384] [PATCH v2] " Maxime Devos
@ 2021-09-05 22:40 ` Maxime Devos
2021-09-06 8:39 ` zimoun
2021-09-09 14:51 ` [bug#50384] [PATCH] " Ludovic Courtès
2 siblings, 0 replies; 16+ messages in thread
From: Maxime Devos @ 2021-09-05 22:40 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 50384
[-- Attachment #1: Type: text/plain, Size: 849 bytes --]
Maxime Devos schreef op zo 05-09-2021 om 21:48 [+0200]:
> Ludovic Courtès schreef op zo 05-09-2021 om 00:04 [+0200]:
> > Maxime Devos <maximedevos@telenet.be> skribis:
> >
[..]
> I added two patches adding (limited) dependency tracking to compile-all.scm.
> If a patch file is now modified or deleted, the corresponding package modules
> will be recompiled. This should remove the ‘evilness’ I think.
Oops, I forgot to include the following change to build-aux/compile-all.scm:
(or (not (file-exists? go))
(file-mtime<? go file)
- (any (cut file-mtime<? go <>) extra-dependencies))))
+ (any (lambda (dependency)
+ (or (not (file-exists? dependency))
+ (file-mtime<? go dependency))) extra-dependencies))))
It will be included in the v3.
Greetings,
Maxime.
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 16+ messages in thread
* [bug#50384] [PATCH v2] Optimise search-patch (reducing I/O)
2021-09-05 19:48 ` [bug#50384] [PATCH v2] " Maxime Devos
2021-09-05 22:40 ` Maxime Devos
@ 2021-09-06 8:39 ` zimoun
2021-09-06 10:06 ` Maxime Devos
2021-09-09 14:51 ` [bug#50384] [PATCH] " Ludovic Courtès
2 siblings, 1 reply; 16+ messages in thread
From: zimoun @ 2021-09-06 8:39 UTC (permalink / raw)
To: Maxime Devos, Ludovic Courtès; +Cc: 50384
Hi Maxime,
Thanks for looking at optimising stuff. :-)
On Sun, 05 Sep 2021 at 21:48, Maxime Devos <maximedevos@telenet.be> wrote:
> Let's compare the numbers again! This time, I've run
>
> echo powersave |sudo tee /sys/devices/system/cpu/cpufreq/policy{0,1,2,3}/scaling_governor
>
> to make sure the CPU frequency doesn't change. On a hot (disk) cache:
>
> # After the patch series
> time GUIX_PROFILING="rpc gc" ./the-optimised-guix/bin/guix build -d --no-grafts pigx
[...]
> So on a hot disk cache, there doesn't appear to be any improvement
> (except for ‘time spent in GC’ -- presumably that's due to the optimisations
> to guix/base32.scm).
Which kind of disk do you have? SSD, spinning HDD, other?
> What about a cold cache?
>
> # After the patch series
>
> sync && echo 3 | sudo tee /proc/sys/vm/drop_caches
> ./the-optimised-guix/bin/guix --help
> time GUIX_PROFILING="rpc gc" ./the-optimised-guix/bin/guix build -d --no-grafts pigx
> /gnu/store/fq6x8d2vcm6sbjkimg7g8kcgb4c5xv1b-pigx-0.0.3.drv
> Remote procedure call summary: 5949 RPCs
> built-in-builders ... 1
> add-to-store ... 3
> add-to-store/tree ... 26
> add-temp-root ... 195
> valid-path? ... 195
> add-text-to-store ... 5529
> Garbage collection statistics:
> heap size: 93.85 MiB
> allocated: 312.03 MiB
> GC times: 17
> time spent in GC: 3.37 seconds (23% of user time)
>
> real 1m39,178s
> user 0m14,557s
> sys 0m0,990s
How the average (against 3 examples) looks like?
> It seems that if the disk cache is cold, the time-to-derivation decreases
> a little by this patch series. Much less than I had hoped for though; I'll
> have to look into other areas for interesting performance gains ...
Please update the number using your diff showed in [1]. :-)
1: <http://issues.guix.gnu.org/50384#4>
All the best,
simon
^ permalink raw reply [flat|nested] 16+ messages in thread
* [bug#50384] [PATCH v2] Optimise search-patch (reducing I/O)
2021-09-06 8:39 ` zimoun
@ 2021-09-06 10:06 ` Maxime Devos
0 siblings, 0 replies; 16+ messages in thread
From: Maxime Devos @ 2021-09-06 10:06 UTC (permalink / raw)
To: zimoun, Ludovic Courtès; +Cc: 50384
[-- Attachment #1: Type: text/plain, Size: 3055 bytes --]
zimoun schreef op ma 06-09-2021 om 10:39 [+0200]:
> Hi Maxime,
>
> Thanks for looking at optimising stuff. :-)
>
> On Sun, 05 Sep 2021 at 21:48, Maxime Devos <maximedevos@telenet.be> wrote:
>
> > Let's compare the numbers again! This time, I've run
> >
> > echo powersave |sudo tee /sys/devices/system/cpu/cpufreq/policy{0,1,2,3}/scaling_governor
> >
> > to make sure the CPU frequency doesn't change. On a hot (disk) cache:
> >
> > # After the patch series
> > time GUIX_PROFILING="rpc gc" ./the-optimised-guix/bin/guix build -d --no-grafts pigx
>
> [...]
>
> > So on a hot disk cache, there doesn't appear to be any improvement
> > (except for ‘time spent in GC’ -- presumably that's due to the optimisations
> > to guix/base32.scm).
>
> Which kind of disk do you have? SSD, spinning HDD, other?
A spinning disk, presumably a HDD. FWIW, it's a ‘TOSHIBA MQ01ABD100 (AX1P2C)’
that has been ‘on’ for 10 months and 10 days, according to ‘SMART-data and selftests’
I just noticed it has ‘2304 bad sectors’. Maybe I should make backups and run file
system checks?
>
> > What about a cold cache?
> >
> > # After the patch series
> >
> > sync && echo 3 | sudo tee /proc/sys/vm/drop_caches
> > ./the-optimised-guix/bin/guix --help
> > time GUIX_PROFILING="rpc gc" ./the-optimised-guix/bin/guix build -d --no-grafts pigx
> > /gnu/store/fq6x8d2vcm6sbjkimg7g8kcgb4c5xv1b-pigx-0.0.3.drv
> > Remote procedure call summary: 5949 RPCs
> > built-in-builders ... 1
> > add-to-store ... 3
> > add-to-store/tree ... 26
> > add-temp-root ... 195
> > valid-path? ... 195
> > add-text-to-store ... 5529
> > Garbage collection statistics:
> > heap size: 93.85 MiB
> > allocated: 312.03 MiB
> > GC times: 17
> > time spent in GC: 3.37 seconds (23% of user time)
> >
> > real 1m39,178s
> > user 0m14,557s
> > sys 0m0,990s
>
> How the average (against 3 examples) looks like?
I'll try to optimise more things and report the average for the v3.
> > It seems that if the disk cache is cold, the time-to-derivation decreases
> > a little by this patch series. Much less than I had hoped for though; I'll
> > have to look into other areas for interesting performance gains ...
>
> Please update the number using your diff showed in [1]. :-)
>
>
> 1: <http://issues.guix.gnu.org/50384#4>
Are you referring to:
> Oops, I forgot to include the following change to build-aux/compile-all.scm:
> (or (not (file-exists? go))
> (file-mtime<? go file)
> - (any (cut file-mtime<? go <>) extra-dependencies))))
> + (any (lambda (dependency)
> + (or (not (file-exists? dependency))
> + (file-mtime<? go dependency))) extra-dependencies))))
That's compilation-time only, so that cannot affect the timing of "guix build -d ...".
Geetings,
Maxime.
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 16+ messages in thread
* [bug#50384] [PATCH] Optimise search-patch (reducing I/O)
2021-09-05 19:48 ` [bug#50384] [PATCH v2] " Maxime Devos
2021-09-05 22:40 ` Maxime Devos
2021-09-06 8:39 ` zimoun
@ 2021-09-09 14:51 ` Ludovic Courtès
2021-09-21 16:55 ` [bug#50384] [PATCH v4] " Ludovic Courtès
2 siblings, 1 reply; 16+ messages in thread
From: Ludovic Courtès @ 2021-09-09 14:51 UTC (permalink / raw)
To: Maxime Devos; +Cc: 50384
Hello,
Maxime Devos <maximedevos@telenet.be> skribis:
>> To address this, ‘local-file’ could store the inode/mtime + computed
>> store file name (rather than the SHA256). ‘local-file-compiler’ would
>> check whether the actual file has matching inode/mtime before returning
>> the computed store file name. Problem is that inode/mtime are
>> guaranteed to differ once you’ve run “make install”. :-/
>
> An additional problem is that 'local-file-compiler' would have to 'stat'
> the file even if it is already in the store, undoing the (fairly limited?)
> performance gains of this patch series.
>
> The dependency tracking avoids this.
OK.
>> Intuitively, I’d have imagined a cache populated at run time; it would
>> map, say, file name/inode/mtime to a store file name. ‘add-to-store’
>> (or some wrapper above it) would check the cache and return the store
>> file name directly, unless ‘valid-path?’ says it no longer exists.
>> Downside is that this would be a per-user cache and you’d still pay the
>> cost until it’s warm. Advantage is that you could easily tell whether
>> it’s stale.
>>
>> Thoughts?
>
> Intuitively, I'd have imagined doing as much as possible at compilation time.
Of course, but it’s important for the caching model to match “reality”,
which is that patch files live independently of the source files that
refer to them.
I’d all be fine if ‘local-file’ were to inline file contents at
macro-expansion time, because then we could be sure the hash and
contents match (but I’m not saying we should do this…).
What we could do is have a boolean saying whether the cached value is
authoritative, similar to what’s in (gnu packages). That way, when
using ./pre-inst-env or passing a -L flag or setting GUIX_PACKAGE_PATH,
the cached value would not be authoritative; we’d be safe, without
needing ad hoc dependency tracking.
Thoughts?
[...]
> Because fixed-output-path is now called more often, I've added a patch
> optimising (guix base32).
[...]
> From e5dc46800597023dfc1c9d53cc6e0db2f3999022 Mon Sep 17 00:00:00 2001
> From: Maxime Devos <maximedevos@telenet.be>
> Date: Sat, 4 Sep 2021 15:35:51 +0200
> Subject: [PATCH v2 3/9] gexp: Allow computing the hash of the local file in
> advance.
>
> The new field is currently unused. The following patches will
> populate and use the field to reduce the time-to-derivation
> when the file is already interned in the store.
>
> * guix/gexp.scm
> (<local-file>): Add sha256 field.
> (%local-file): Add sha256 argument for populating the field.
> (local-file-compiler): Adjust 'match' expression.
[...]
> +;; repeated 'stat' calls. Allow computing the hash of the file in advance,
> +;; to avoid having to send the file to the daemon when it is already interned
> +;; in the store.
> (define-record-type <local-file>
> - (%%local-file file absolute name recursive? select?)
> + (%%local-file file absolute name sha256 recursive? select?)
> local-file?
> (file local-file-file) ;string
> (absolute %local-file-absolute-file-name) ;promise string
> (name local-file-name) ;string
> + (sha256 local-file-sha256) ;sha256 bytevector | #f
Could we store the result of ‘fixed-output-path’ rather than the SHA256,
while we’re at it?
Again, care must be taken because it’s possible to set NIX_STORE_DIR at
run time, which may invalidate the pre-computed store file name.
Can we make hash/file name computation a feature of ‘local-file’ rather
than one of ‘search-patch’ as in these patches? I’d rather not provide
a way to override this new field.
There are cases where we cannot know the value of ‘recursive?’ at
expansion time, for instance if the user wrote:
(local-file "foo.txt" #:recursive? r)
In that case, we cannot compute the hash or file name.
Thanks,
Ludo’.
^ permalink raw reply [flat|nested] 16+ messages in thread
* [bug#50384] [PATCH v3] Optimise search-patch (reducing I/O)
2021-09-04 21:17 [bug#50384] [PATCH] Optimise search-patch (reducing I/O) Maxime Devos
2021-09-04 21:47 ` Ludovic Courtès
2021-09-04 22:04 ` Ludovic Courtès
@ 2021-09-09 20:25 ` Maxime Devos
2021-09-10 9:54 ` bug#50384: " Maxime Devos
2 siblings, 1 reply; 16+ messages in thread
From: Maxime Devos @ 2021-09-09 20:25 UTC (permalink / raw)
To: 50384; +Cc: Ludovic Courtès, zimoun
[-- Attachment #1.1: Type: text/plain, Size: 4806 bytes --]
Hi guix,
This is a v3, without the base16 and base32 optimisations which
are split-off into <https://issues.guix.gnu.org/50456>. It doesn't
seem this patch series will bring improvements, but feel free to test
(in particular, I wonder if this will help people using a remote daemon,
where transmitting data can take (relatively) long?).
(guix scripts hash) is broken, which would need to be fixed in the final
version, if any. Ludovic has some concerns about dependency tracking in
search-patch which need to be adressed.
I think a more fruitful goal is to somehow parallelize the derivation
computation, with multiple separate connections to the store, such that
if one connection is blocking, the other one can be used for something
separate (threads aren't necessary if current-read-waiter,
current-write-waiter and non-blocking I/O are used).
Now, what improvements does this version of the patch series bring?
(Make sure to start the daemon with ./pre-inst-env guix daemon ...,
and set --localstatedir=/var! Some changes to the daemon were made.)
1. RPC count (tested in a local checkout)
After the patch series:
make && GUIX_PROFILING=rpc ./pre-inst-env guix build -d pigx --no-grafts
accepted connection from pid 4917, user [USER]
/gnu/store/jfjfg7dnis7v6947a0rncxdn3y1nz0ad-pigx-0.0.3.drv
Remote procedure call summary: 5754 RPCs
built-in-builders ... 1
add-to-store ... 3
add-to-store/tree ... 26
add-temp-root-and-valid-path? ... 195
add-text-to-store ... 5529
After the patch series, with (if sha256 ...) replaced with (if #f ...)
in (guix gexp), to simulate the situation before the patch series
/gnu/store/jfjfg7dnis7v6947a0rncxdn3y1nz0ad-pigx-0.0.3.drv
Remote procedure call summary: 5749 RPCs
built-in-builders ... 1
add-to-store/tree ... 26
add-to-store ... 193
add-text-to-store ... 5529
(add-to-store RPCs are converted to add-temp-root-and-valid-path? RPCs)
2. Timing
First do
echo powersave | sudo tee /sys/devices/system/cpu/cpu{0,1,2,3}/cpufreq/scaling_governor
to eliminate CPU frequency scaling effects.
To automatically repeat the tests and compute the standard deviation,
'hyperfine' is used:
HYP=/gnu/store/3ya4iw6fzq1ns73bv1g3a96jvwhbv60c-hyperfine-1.11.0/bin/hyperfine
To determine the effect of the change to 'local-file-compiler' and
'search-patch' and nothing else, I will compare the performance of guix
after the patch series with the performance of guix after the patch series
and 'sha256' replaced by #false.
With #f, --runs=60:
make && ./pre-inst-env $HYP --runs=60 --warmup 1 -- 'guix build -d pigx --no-grafts'
Time (mean ± σ): 15.428 s ± 0.385 s [User: 15.925 s, System: 0.652 s]
Range (min … max): 14.768 s … 16.550 s 60 runs
With sha256, --runs=60
make && ./pre-inst-env $HYP --runs=60 --warmup 1 -- 'guix build -d pigx --no-grafts'
Time (mean ± σ): 15.493 s ± 0.252 s [User: 15.585 s, System: 0.680 s]
Range (min … max): 14.981 s … 16.294 s 60 runs
These numbers don't have a clear difference. Maybe statistics can help? First,
formulate a null-hypothesis. As the total number of RPCs didn't change, the amount
of data sent to the daemon is reduced and some "stats", "open" and "reads" are avoided,
I would expect that the mean decreases. Thus, as null-hypothesis, I choose:
H0: the (theoretical) mean for ‘with sha256’ is less than the mean for ‘with #f’
In the timing tests, the observed mean for 'with sha256’ is actually larger.
But is this significant?
guix environment --ad-hoc r
before.mean = 15.428
before.stddev = 0.385
after.mean = 15.493
after.stddev = 0.252
samples = 60
# ‘statistical’ crate used by hyperfine
# performs N/(N-1) correction XXX
t = (before.mean - after.mean)/(sqrt(samples) * sqrt(before.stddev^2 + after.stddev^2))
v = (samples - 1) * (before.stddev^2 + after.stddev^2)^2/(before.stddev^4 + after.stddev^4)
q = dt(-t, v); q
# p-value: 0.5072571
# Null-hypothesis is not rejected
It's not rejected, though that doesn't prove much since t is almost zero,
so this test cannot reject the hypothesis ‘the means are equal’ or ‘the patch
series makes things slower’ either.
I don't think this patch series helps on my laptop (at least on a hot disk cache, I'd have
to check for a cold cache). However, I wonder if this would help a little for people
using a remote build daemon (with a nfs setup or something) (see GUIX_DAEMON_SOCKET)?
Greetings,
Maxime.
[-- Attachment #1.2: 0001-build-self-Implement-basic-hash-algorithm.patch --]
[-- Type: text/x-patch, Size: 1862 bytes --]
From cfffe62fff71885db9feb1c46ee5d0b6bbe2f4c7 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 4 Sep 2021 20:09:03 +0200
Subject: [PATCH 01/10] build-self: Implement basic 'hash-algorithm'.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
The module (guix hash) used from 'search-patch' in a future
patch needs it to be properly defined when (guix hash) is being
compiled. 'search-patch' is used when the derivation of Guix is
being computed, so it is important to avoid the ‘wrong type to
apply: #<syntax-transformer hash-algorithm>’ error.
* build-aux/build-self.scm
(build-program)[fake-gcrypt-hash]: Define hash-algorithm for sha1
and sha256.
---
build-aux/build-self.scm | 13 +++++++++++--
1 file changed, 11 insertions(+), 2 deletions(-)
diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm
index 3a2d13cc09..2c13d9d530 100644
--- a/build-aux/build-self.scm
+++ b/build-aux/build-self.scm
@@ -259,8 +259,17 @@ interface (FFI) of Guile.")
(define fake-gcrypt-hash
;; Fake (gcrypt hash) module; see below.
(scheme-file "hash.scm"
- #~(define-module (gcrypt hash)
- #:export (sha1 sha256))))
+ #~(begin
+ (define-module (gcrypt hash)
+ #:export (sha1 sha256 hash-algorithm))
+ ;; Avoid ‘Wrong type to apply:
+ ;; #<syntax-transformer hash-algorithm>’ errors.
+ (define sha1)
+ (define sha256)
+ (define-syntax hash-algorithm
+ (syntax-rules (sha1 sha256)
+ ((_ sha1) 2)
+ ((_ sha256) 8))))))
(define fake-git
(scheme-file "git.scm" #~(define-module (git))))
--
2.33.0
[-- Attachment #1.3: 0002-guix-hash-Extract-file-hashing-procedures.patch --]
[-- Type: text/x-patch, Size: 5553 bytes --]
From fc53524130e56bbdb53c97e0e47ef2029d7dbad9 Mon Sep 17 00:00:00 2001
From: Sarah Morgensen <iskarian@mgsn.dev>
Date: Sun, 15 Aug 2021 16:25:24 -0700
Subject: [PATCH 02/10] guix hash: Extract file hashing procedures.
* guix/scripts/hash.scm (guix-hash)[vcs-file?, file-hash]: Extract logic
to...
* guix/hash.scm: ...here. New file.
* Makefile.am (MODULES): Add new file.
---
Makefile.am | 1 +
guix/hash.scm | 51 +++++++++++++++++++++++++++++++++++++++++++
guix/scripts/hash.scm | 29 ++++++------------------
3 files changed, 59 insertions(+), 22 deletions(-)
create mode 100644 guix/hash.scm
diff --git a/Makefile.am b/Makefile.am
index 327d3f9961..8f8089c05c 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -107,6 +107,7 @@ MODULES = \
guix/narinfo.scm \
guix/derivations.scm \
guix/grafts.scm \
+ guix/hash.scm \
guix/repl.scm \
guix/transformations.scm \
guix/inferior.scm \
diff --git a/guix/hash.scm b/guix/hash.scm
new file mode 100644
index 0000000000..8c2ab8187f
--- /dev/null
+++ b/guix/hash.scm
@@ -0,0 +1,51 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix hash)
+ #:use-module (gcrypt hash)
+ #:use-module (guix serialization)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
+ #:export (vcs-file?
+ file-hash*))
+
+(define (vcs-file? file stat)
+ "Returns true if FILE is a version control system file."
+ (case (stat:type stat)
+ ((directory)
+ (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS")))
+ ((regular)
+ ;; Git sub-modules have a '.git' file that is a regular text file.
+ (string=? (basename file) ".git"))
+ (else
+ #f)))
+
+(define* (file-hash* file #:key
+ (algorithm (hash-algorithm sha256))
+ (recursive? #t)
+ (select? (negate vcs-file?)))
+ "Compute the hash of FILE with ALGORITHM. If RECURSIVE? is true, recurse
+into subdirectories of FILE, computing the combined hash of all files for
+which (SELECT? FILE STAT) returns true."
+ (if recursive?
+ (let-values (((port get-hash)
+ (open-hash-port algorithm)))
+ (write-file file port #:select? select?)
+ (force-output port)
+ (get-hash))
+ (file-hash algorithm file)))
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index b8622373cc..353ca30c2c 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,6 +24,7 @@
#:use-module (gcrypt hash)
#:use-module (guix serialization)
#:use-module (guix ui)
+ #:use-module (guix hash)
#:use-module (guix scripts)
#:use-module (guix base16)
#:use-module (guix base32)
@@ -125,16 +127,6 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
(parse-command-line args %options (list %default-options)
#:build-options? #f))
- (define (vcs-file? file stat)
- (case (stat:type stat)
- ((directory)
- (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS")))
- ((regular)
- ;; Git sub-modules have a '.git' file that is a regular text file.
- (string=? (basename file) ".git"))
- (else
- #f)))
-
(let* ((opts (parse-options))
(args (filter-map (match-lambda
(('argument . value)
@@ -150,18 +142,11 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
;; Compute the hash of FILE.
;; Catch and gracefully report possible '&nar-error' conditions.
(with-error-handling
- (if (assoc-ref opts 'recursive?)
- (let-values (((port get-hash)
- (open-hash-port (assoc-ref opts 'hash-algorithm))))
- (write-file file port #:select? select?)
- (force-output port)
- (get-hash))
- (match file
- ("-" (port-hash (assoc-ref opts 'hash-algorithm)
- (current-input-port)))
- (_ (call-with-input-file file
- (cute port-hash (assoc-ref opts 'hash-algorithm)
- <>)))))))
+ (match file
+ ("-" (port-hash (assoc-ref opts 'hash-algorithm)
+ (current-input-port)))
+ (_ (file-hash* #:algorithm (assoc-ref opts 'hash-algorithm)
+ #:recursive? (assoc-ref opts 'recursive?))))))
(match args
((file)
--
2.33.0
[-- Attachment #1.4: 0003-store-Define-new-add-temp-root-and-valid-path-operat.patch --]
[-- Type: text/x-patch, Size: 5217 bytes --]
From 62ad973fe48319caaadede5c36370bcd08542fbf Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Thu, 9 Sep 2021 17:42:49 +0200
Subject: [PATCH 03/10] store: Define new add-temp-root-and-valid-path?
operation.
This will allow speeding up 'local-file-compiler' a little,
see <https://issues.guix.gnu.org/50384>.
* nix/libstore/worker-protocols.hh
(WorkerOp)[wopAddTempRootAndIsValidPath): New operation.
(PROTOCOL_VERSION): Bump version.
* nix/nix-daemon/nix-daemon.cc
(performOp)[wopAddTempRootAndIsValidPath]: Handle new operation.
* guix/store.scm
(add-temp-root-and-valid-path?): New operation.
(operation-id)[add-temp-root-and-valid-path?): New operation.
(%protocol-version): Bump version.
* tests/store.scm
("add-temp-root-valid-path? live", "add-temp-root-and-valid-path? false"):
New tests.
---
guix/store.scm | 11 +++++++++--
nix/libstore/worker-protocol.hh | 5 +++--
nix/nix-daemon/nix-daemon.cc | 12 ++++++++++++
tests/store.scm | 10 ++++++++++
4 files changed, 34 insertions(+), 4 deletions(-)
diff --git a/guix/store.scm b/guix/store.scm
index 0463b0e8fa..c9f7b905b7 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -124,6 +124,7 @@
ensure-path
find-roots
add-temp-root
+ add-temp-root-and-valid-path?
add-indirect-root
add-permanent-root
remove-permanent-root
@@ -195,7 +196,7 @@
derivation-log-file
log-file))
-(define %protocol-version #x163)
+(define %protocol-version #x164)
(define %worker-magic-1 #x6e697863) ; "nixc"
(define %worker-magic-2 #x6478696f) ; "dxio"
@@ -249,7 +250,8 @@
(query-valid-derivers 33)
(optimize-store 34)
(verify-store 35)
- (built-in-builders 80))
+ (built-in-builders 80)
+ (add-temp-root-and-valid-path? 81))
(define-enumerate-type hash-algo
;; hash.hh
@@ -1455,6 +1457,11 @@ potential roots that do not point to store items."
Return #t."
boolean)
+(define-operation (add-temp-root-and-valid-path? (store-path path))
+ "Make PATH a temporary root for the duration of the current session,
+and test if PATH is a valid store path (see 'valid-path?')."
+ boolean)
+
(define-operation (add-indirect-root (string file-name))
"Make the symlink FILE-NAME an indirect root for the garbage collector:
whatever store item FILE-NAME points to will not be collected. Return #t on
diff --git a/nix/libstore/worker-protocol.hh b/nix/libstore/worker-protocol.hh
index ea67b10a5b..bb99e632cf 100644
--- a/nix/libstore/worker-protocol.hh
+++ b/nix/libstore/worker-protocol.hh
@@ -6,7 +6,7 @@ namespace nix {
#define WORKER_MAGIC_1 0x6e697863
#define WORKER_MAGIC_2 0x6478696f
-#define PROTOCOL_VERSION 0x163
+#define PROTOCOL_VERSION 0x164
#define GET_PROTOCOL_MAJOR(x) ((x) & 0xff00)
#define GET_PROTOCOL_MINOR(x) ((x) & 0x00ff)
@@ -44,7 +44,8 @@ typedef enum {
wopQueryValidDerivers = 33,
wopOptimiseStore = 34,
wopVerifyStore = 35,
- wopBuiltinBuilders = 80
+ wopBuiltinBuilders = 80,
+ wopAddTempRootAndIsValidPath = 81
} WorkerOp;
diff --git a/nix/nix-daemon/nix-daemon.cc b/nix/nix-daemon/nix-daemon.cc
index 497de11a04..b73bb15a64 100644
--- a/nix/nix-daemon/nix-daemon.cc
+++ b/nix/nix-daemon/nix-daemon.cc
@@ -306,6 +306,18 @@ static void performOp(bool trusted, unsigned int clientVersion,
break;
}
+ case wopAddTempRootAndIsValidPath: {
+ /* This is a combination of AddTempRoot and IsValidPath, to reduce
+ the numer of RPC calls made by ‘local-file-compiler’ in (guix gexp). */
+ Path path = readStorePath(from);
+ startWork();
+ store->addTempRoot(path);
+ bool result = store->isValidPath(path);
+ stopWork();
+ writeInt(result, to);
+ break;
+ }
+
case wopQueryValidPaths: {
PathSet paths = readStorePaths<PathSet>(from);
startWork();
diff --git a/tests/store.scm b/tests/store.scm
index 3266fa7a82..d724ff18b2 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -138,10 +139,19 @@
(let ((p (add-text-to-store %store "hello" "hello, world")))
(valid-path? %store p)))
+(test-assert "add-temp-root-valid-path? live"
+ (let ((p (add-text-to-store %store "hello" "hello, world")))
+ (add-temp-root-and-valid-path? %store p)))
+
(test-assert "valid-path? false"
(not (valid-path? %store
(string-append (%store-prefix) "/"
(make-string 32 #\e) "-foobar"))))
+(test-assert "add-temp-root-and-valid-path? false"
+ (not (add-temp-root-and-valid-path?
+ %store
+ (string-append (%store-prefix) "/"
+ (make-string 32 #\e) "-foobar"))))
(test-equal "with-store, multiple values" ;<https://bugs.gnu.org/42912>
'(1 2 3)
--
2.33.0
[-- Attachment #1.5: 0004-store-Add-compatibility-fall-back-for-add-temp-root-.patch --]
[-- Type: text/x-patch, Size: 2304 bytes --]
From 43578f3fbb7f184881ae4f1ca6b4cf3df8b67c11 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Thu, 9 Sep 2021 18:59:41 +0200
Subject: [PATCH 04/10] store: Add compatibility fall-back for
'add-temp-root-and-valid-path?'.
* guix/store.scm (add-temp-root-and-valid-path?): Rename to ...
(add-temp-root-and-valid-path*?): ... this.
(add-temp-root-and-valid-path?): New procedure.
---
guix/store.scm | 16 ++++++++++++++--
1 file changed, 14 insertions(+), 2 deletions(-)
diff --git a/guix/store.scm b/guix/store.scm
index c9f7b905b7..f2fb246fca 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
;;; Copyright © 2020 Lars-Dominik Braun <ldb@leibniz-psychology.org>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -124,7 +125,7 @@
ensure-path
find-roots
add-temp-root
- add-temp-root-and-valid-path?
+ (add-temp-root-and-valid-path*? . add-temp-root-and-valid-path?)
add-indirect-root
add-permanent-root
remove-permanent-root
@@ -1459,9 +1460,20 @@ Return #t."
(define-operation (add-temp-root-and-valid-path? (store-path path))
"Make PATH a temporary root for the duration of the current session,
-and test if PATH is a valid store path (see 'valid-path?')."
+and test if PATH is a valid store path (see 'valid-path?'). This requires
+a recent daemon version (#x164 or later); use 'add-temp-root-and-valid-path*?'
+for compatibility."
boolean)
+(define (add-temp-root-and-valid-path*? store path)
+ "Make PATH a temporary root for the duration of the current session,
+and test if PATH is a valid store path (see 'valid-path?')."
+ (if (>= (store-connection-minor-version store) #x64)
+ (add-temp-root-and-valid-path? store path)
+ (begin
+ (add-temp-root store path)
+ (valid-path? store path))))
+
(define-operation (add-indirect-root (string file-name))
"Make the symlink FILE-NAME an indirect root for the garbage collector:
whatever store item FILE-NAME points to will not be collected. Return #t on
--
2.33.0
[-- Attachment #1.6: 0005-gexp-Allow-computing-the-hash-of-the-local-file-in-a.patch --]
[-- Type: text/x-patch, Size: 3316 bytes --]
From 75cb3a1e7b00b95b2aa05373bc7c0e836766c8c0 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 4 Sep 2021 15:35:51 +0200
Subject: [PATCH 05/10] gexp: Allow computing the hash of the local file in
advance.
The new field is currently unused. The following patches will
populate and use the field to reduce the time-to-derivation
when the file is already interned in the store.
* guix/gexp.scm
(<local-file>): Add sha256 field.
(%local-file): Add sha256 argument for populating the field.
(local-file-compiler): Adjust 'match' expression.
---
guix/gexp.scm | 12 ++++++++----
1 file changed, 8 insertions(+), 4 deletions(-)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index f3d278b3e6..a633984688 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -419,13 +419,16 @@ Here TARGET is bound to the cross-compilation triplet or #f."
;; A local file name. FILE is the file name the user entered, which can be a
;; relative file name, and ABSOLUTE is a promise that computes its canonical
;; absolute file name. We keep it in a promise to compute it lazily and avoid
-;; repeated 'stat' calls.
+;; repeated 'stat' calls. Allow computing the hash of the file in advance,
+;; to avoid having to send the file to the daemon when it is already interned
+;; in the store.
(define-record-type <local-file>
- (%%local-file file absolute name recursive? select?)
+ (%%local-file file absolute name sha256 recursive? select?)
local-file?
(file local-file-file) ;string
(absolute %local-file-absolute-file-name) ;promise string
(name local-file-name) ;string
+ (sha256 local-file-sha256) ;sha256 bytevector | #f
(recursive? local-file-recursive?) ;Boolean
(select? local-file-select?)) ;string stat -> Boolean
@@ -434,6 +437,7 @@ Here TARGET is bound to the cross-compilation triplet or #f."
(define* (%local-file file promise #:optional (name (basename file))
#:key
(literal? #t) location
+ sha256
recursive? (select? true))
;; This intermediate procedure is part of our ABI, but the underlying
;; %%LOCAL-FILE is not.
@@ -441,7 +445,7 @@ Here TARGET is bound to the cross-compilation triplet or #f."
(warning (and=> location source-properties->location)
(G_ "resolving '~a' relative to current directory~%")
file))
- (%%local-file file promise name recursive? select?))
+ (%%local-file file promise name sha256 recursive? select?))
(define (absolute-file-name file directory)
"Return the canonical absolute file name for FILE, which lives in the
@@ -517,7 +521,7 @@ appears."
(define-gexp-compiler (local-file-compiler (file <local-file>) system target)
;; "Compile" FILE by adding it to the store.
(match file
- (($ <local-file> file (= force absolute) name recursive? select?)
+ (($ <local-file> file (= force absolute) name sha256 recursive? select?)
;; Canonicalize FILE so that if it's a symlink, it is resolved. Failing
;; to do that, when RECURSIVE? is #t, we could end up creating a dangling
;; symlink in the store, and when RECURSIVE? is #f 'add-to-store' would
--
2.33.0
[-- Attachment #1.7: 0006-gexp-Allow-overriding-the-absolute-file-name.patch --]
[-- Type: text/x-patch, Size: 2452 bytes --]
From d647fd713b0a9e2b1b1bcacfa9546da9ce23c690 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 4 Sep 2021 16:25:22 +0200
Subject: [PATCH 06/10] gexp: Allow overriding the absolute file name.
This will be used by the next patch to implement search-patch in
terms of local-file.
* guix/gexp.scm
(precanonicalized-file-name): New macro.
(local-file): Use the absolute file name from precanonicalized-file-name
when available.
---
guix/gexp.scm | 12 +++++++++++-
1 file changed, 11 insertions(+), 1 deletion(-)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index a633984688..c69e4aa299 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -51,6 +51,7 @@
gexp-input-output
gexp-input-native?
+ precanonicalized-file-name
assume-valid-file-name
local-file
local-file?
@@ -463,6 +464,12 @@ the given file name is valid, even if it's not a string literal, and thus not
warn about it."
file)
+(define-syntax-rule (precanonicalized-file-name file absolute)
+ "This is a syntactic keyword to tell 'local-file' that it can assume that
+the given file name FILE has ABSOLUTE as absolute file name and 'local-file'
+does not need to compute the absolute file name by itself."
+ absolute)
+
(define-syntax local-file
(lambda (s)
"Return an object representing local file FILE to add to the store; this
@@ -481,7 +488,7 @@ where FILE is the entry's absolute file name and STAT is the result of
This is the declarative counterpart of the 'interned-file' monadic procedure.
It is implemented as a macro to capture the current source directory where it
appears."
- (syntax-case s (assume-valid-file-name)
+ (syntax-case s (assume-valid-file-name precanonicalized-file-name)
((_ file rest ...)
(string? (syntax->datum #'file))
;; FILE is a literal, so resolve it relative to the source directory.
@@ -495,6 +502,9 @@ appears."
#'(%local-file file
(delay (absolute-file-name file (getcwd)))
rest ...))
+ ((_ (precanonicalized-file-name file absolute) rest ...)
+ ;; Use the given file name ABSOLUTE as absolute file name.
+ #'(%local-file file (delay absolute) rest ...))
((_ file rest ...)
;; Resolve FILE relative to the current directory.
(with-syntax ((location (datum->syntax s (syntax-source s))))
--
2.33.0
[-- Attachment #1.8: 0007-packages-Compute-the-hash-of-patches-in-advance-when.patch --]
[-- Type: text/x-patch, Size: 9375 bytes --]
From 6628ccda39624346e7df7d660f805b6906c3b1d0 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 4 Sep 2021 17:25:58 +0200
Subject: [PATCH 07/10] packages: Compute the hash of patches in advance when
possible.
* gnu/packages.scm
(search-patch): Rename to ...
(%search-patch): ... this.
(try-search-patch): New procedure, extracted from ...
(%search-patch): ... this procedure.
(%local-patch-file): New procedure.
(true): New procedure.
(search-patch): New macro, behaving like %search-patch, but computing the
hash at expansion time when possible.
* gnu/packages/chromium.scm
(%guix-patches): Use search-patches instead of local-file +
assume-valid-file-name + search-patch.
* gnu/packages/gnuzilla.scm
(icecat-source)[gnuzilla-fixes-patch]: Use search-patch instead of
local-file + assule-valid-file-name + search-patch.
(icecat-source)[makeicecat-patch]: Likewise.
* gnu/packages/embedded.scm
(gcc-arm-none-eabi-4.9)[source]{patches}: Expect patches to be
local-file objects instead of strings.
of strings.
* guix/lint.scm (check-patch-file-names): Allow local-file objects.
---
gnu/packages.scm | 42 +++++++++++++++++++++++++++++++++++++--
gnu/packages/chromium.scm | 4 +---
gnu/packages/embedded.scm | 3 ++-
gnu/packages/gnuzilla.scm | 8 ++------
guix/lint.scm | 28 ++++++++++++++++----------
5 files changed, 62 insertions(+), 23 deletions(-)
diff --git a/gnu/packages.scm b/gnu/packages.scm
index ccfc83dd11..f5552e5a9b 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,11 +22,13 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages)
+ #:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix diagnostics)
#:use-module (guix discovery)
+ #:use-module (guix hash)
#:use-module (guix memoization)
#:use-module ((guix build utils)
#:select ((package-name->name+version
@@ -90,12 +93,47 @@
"Search the auxiliary FILE-NAME. Return #f if not found."
(search-path (%auxiliary-files-path) file-name))
-(define (search-patch file-name)
+(define (try-search-patch file-name)
+ "Search the patch FILE-NAME. Return #f if not found."
+ (search-path (%patch-path) file-name))
+
+(define (%search-patch file-name)
"Search the patch FILE-NAME. Raise an error if not found."
- (or (search-path (%patch-path) file-name)
+ (or (try-search-patch file-name)
(raise (formatted-message (G_ "~a: patch not found")
file-name))))
+(define (%local-patch-file file-name hash)
+ "Search the patch FILE-NAME, which is known to have HASH."
+ (local-file (precanonicalized-file-name file-name (%search-patch file-name))
+ #:sha256 hash #:recursive? #t))
+
+(define true (const #t))
+
+(define-syntax search-patch
+ (lambda (s)
+ "Search the patch FILE-NAME and compute its hash at expansion time
+if possible. Return #f if not found."
+ (syntax-case s ()
+ ((_ file-name)
+ (string? (syntax->datum #'file-name))
+ ;; FILE-NAME is a constant string, so the hash can be computed
+ ;; in advance.
+ (let ((patch (try-search-patch (syntax->datum #'file-name))))
+ (if patch
+ #`(%local-patch-file file-name #,(file-hash* patch #:select? true))
+ (begin
+ (warning (source-properties->location
+ (syntax-source #'file-name))
+ (G_ "~a: patch not found at expansion time")
+ (syntax->datum #'ile-name))
+ #'(%search-patch file-name)))))
+ ;; FILE-NAME is variable, so the hash cannot be pre-computed.
+ ((_ file-name) #'(%search-patch file-name))
+ ;; search-patch is being used used in a construct like
+ ;; (map search-patch ...).
+ (id (identifier? #'id) #'%search-patch))))
+
(define-syntax-rule (search-patches file-name ...)
"Return the list of absolute file names corresponding to each
FILE-NAME found in %PATCH-PATH."
diff --git a/gnu/packages/chromium.scm b/gnu/packages/chromium.scm
index 26ae1e2550..cf419cf41b 100644
--- a/gnu/packages/chromium.scm
+++ b/gnu/packages/chromium.scm
@@ -351,9 +351,7 @@
"0wbcbjzh5ak4nciahqw4yvxc4x8ik4x0iz9h4kfy0m011sxzy174"))))
(define %guix-patches
- (list (local-file
- (assume-valid-file-name
- (search-patch "ungoogled-chromium-extension-search-path.patch")))))
+ (search-patches "ungoogled-chromium-extension-search-path.patch"))
;; This is a source 'snippet' that does the following:
;; *) Applies various patches for unbundling purposes and libstdc++ compatibility.
diff --git a/gnu/packages/embedded.scm b/gnu/packages/embedded.scm
index f388c11c3d..826f5655c3 100644
--- a/gnu/packages/embedded.scm
+++ b/gnu/packages/embedded.scm
@@ -30,6 +30,7 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix svn-download)
+ #:use-module (guix gexp)
#:use-module (guix git-download)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system cmake)
@@ -91,7 +92,7 @@
;; Remove the one patch that doesn't apply to this 4.9 snapshot (the
;; patch is for 4.9.4 and later but this svn snapshot is older).
(patches (remove (lambda (patch)
- (string=? (basename patch)
+ (string=? (local-file-name patch)
"gcc-arm-bug-71399.patch"))
(origin-patches (package-source xgcc))))))
(native-inputs
diff --git a/gnu/packages/gnuzilla.scm b/gnu/packages/gnuzilla.scm
index 576bc2586f..be674dce8f 100644
--- a/gnu/packages/gnuzilla.scm
+++ b/gnu/packages/gnuzilla.scm
@@ -736,14 +736,10 @@ from forcing GEXP-PROMISE."
(base32
"00ws3540x5whpicc5fx4k949ff73cqvajz6jp13ahn49wqdads47"))))
- ;; 'search-patch' returns either a valid file name or #f, so wrap it
- ;; in 'assume-valid-file-name' to avoid 'local-file' warnings.
(gnuzilla-fixes-patch
- (local-file (assume-valid-file-name
- (search-patch "icecat-use-older-reveal-hidden-html.patch"))))
+ (search-patch "icecat-use-older-reveal-hidden-html.patch"))
(makeicecat-patch
- (local-file (assume-valid-file-name
- (search-patch "icecat-makeicecat.patch")))))
+ (search-patch "icecat-makeicecat.patch")))
(origin
(method computed-origin-method)
diff --git a/guix/lint.scm b/guix/lint.scm
index 413b0b9905..f708465ed8 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -46,6 +46,7 @@
gexp->approximate-sexp))
#:use-module (guix licenses)
#:use-module (guix records)
+ #:use-module (guix gexp)
#:use-module (guix grafts)
#:use-module (guix upstream)
#:use-module (guix utils)
@@ -932,6 +933,8 @@ patch could not be found."
(starts-with-package-name? (basename patch)))
((? origin? patch)
(starts-with-package-name? (origin-actual-file-name patch)))
+ ((? local-file? patch)
+ (starts-with-package-name? (local-file-name patch)))
(_ #f)) ;must be some other file-like object
patches)
'()
@@ -945,19 +948,22 @@ patch could not be found."
(let ((prefix (string-length (%distro-directory)))
(margin (string-length "guix-2.0.0rc3-10000-1234567890/"))
(max 99))
+ (define (test-patch-name file-name)
+ (if (> (+ margin (if (string-prefix? (%distro-directory) file-name)
+ (- (string-length file-name) prefix)
+ (string-length file-name)))
+ max)
+ (make-warning
+ package
+ (G_ "~a: file name is too long")
+ (list (basename file-name))
+ #:field 'patch-file-names)
+ #f))
(filter-map (match-lambda
((? string? patch)
- (if (> (+ margin (if (string-prefix? (%distro-directory)
- patch)
- (- (string-length patch) prefix)
- (string-length patch)))
- max)
- (make-warning
- package
- (G_ "~a: file name is too long")
- (list (basename patch))
- #:field 'patch-file-names)
- #f))
+ (test-patch-name patch))
+ ((? local-file? patch)
+ (test-patch-name (local-file-absolute-file-name patch)))
(_ #f))
patches)))))
--
2.33.0
[-- Attachment #1.9: 0008-compile-all-compile-Keep-track-of-dependencies-of-co.patch --]
[-- Type: text/x-patch, Size: 8556 bytes --]
From 93a465f3778aae0149a86c4fc8de94435d8dbca6 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sun, 5 Sep 2021 14:02:30 +0200
Subject: [PATCH 08/10] compile-all,compile: Keep track of dependencies of
compiled modules.
This patch defines a 'notice-dependency' procedure.
Macros can use this procedure to inform build-aux/compile-all.scm
that a module needs to be recompiled when some file is updated.
* guix/build/compile.scm
(current-dependency-info, current-output-file): New parameters.
(notice-dependency): New procedure.
(compile-files)[build]: Set 'output-file'. Delete the old compiled file
if necessary. Remove old dependency information.
* build-aux/compile-all.scm: Populate current-dependency-info from a file.
Populate the file dependency-info.scm from the hash table.
(builddir): New variable.
(file-needs-compilation?): Check if the .go file is older than the
dependencies.
* .gitignore: Ignore dependency-info.scm.
---
.gitignore | 1 +
build-aux/compile-all.scm | 39 +++++++++++++++++++++++++++++----
guix/build/compile.scm | 45 ++++++++++++++++++++++++++++++++-------
3 files changed, 73 insertions(+), 12 deletions(-)
diff --git a/.gitignore b/.gitignore
index 88fe24586d..f24ea5fc3b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -154,3 +154,4 @@ tmp
/gnu/packages/bootstrap
/gnu/packages/aux-files/guile-guile-launcher.o
/guile
+/dependency-info.scm
diff --git a/build-aux/compile-all.scm b/build-aux/compile-all.scm
index 9ffbce43ad..902527b083 100644
--- a/build-aux/compile-all.scm
+++ b/build-aux/compile-all.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -20,12 +21,15 @@
(use-modules (ice-9 format)
(ice-9 match)
(ice-9 threads)
+ (ice-9 hash-table)
(srfi srfi-1)
+ (srfi srfi-26)
(guix build compile)
(guix build utils))
(define host (getenv "host"))
(define srcdir (getenv "srcdir"))
+(define builddir (getcwd))
(define (relative-file file)
(if (string-prefix? (string-append srcdir "/") file)
@@ -41,10 +45,35 @@
(without-extension (string-drop-right relative 4)))
(string-append without-extension ".go")))
+;; Read dependency information from previous "make" runs.
+(current-dependency-info (make-hash-table))
+(if (file-exists? "dependency-info.scm")
+ (current-dependency-info
+ (alist->hash-table
+ (call-with-input-file "dependency-info.scm" read #:encoding "UTF-8")))
+ (current-dependency-info (make-hash-table)))
+
+(define (dump-dependency-info)
+ "Dump the current dependency information for the next \"make\" run."
+ (call-with-output-file "dependency-info.scm.new"
+ (lambda (port)
+ (display ";; This is auto-generated by build-aux/compile-all.scm,
+;; do not modify manually!
+" port)
+ (write (hash-map->list cons (current-dependency-info)) port))
+ #:encoding "UTF-8")
+ (rename-file "dependency-info.scm.new" "dependency-info.scm"))
+
(define (file-needs-compilation? file)
- (let ((go (scm->go file)))
+ (let* ((go (scm->go file))
+ (extra-dependencies
+ (hash-ref (current-dependency-info) (in-vicinity builddir go)
+ '())))
(or (not (file-exists? go))
- (file-mtime<? go file))))
+ (file-mtime<? go file)
+ (any (lambda (dependency)
+ (or (not (file-exists? dependency))
+ (file-mtime<? go dependency))) extra-dependencies))))
(define* (parallel-job-count #:optional (flags (getenv "MAKEFLAGS")))
"Return the number of parallel jobs as determined by FLAGS, the flags passed
@@ -109,7 +138,7 @@ to 'make'."
(let* ((to-build (filter file-needs-compilation? files))
(processed (+ processed
(- (length files) (length to-build)))))
- (compile-files srcdir (getcwd) to-build
+ (compile-files srcdir builddir to-build
#:workers (parallel-job-count*)
#:host host
#:report-load (lambda (file total completed)
@@ -127,8 +156,10 @@ to 'make'."
(* 2 processed))
(* 2 grand-total))
(scm->go file))
- (force-output))))))
+ (force-output)))))
+ (dump-dependency-info))
(lambda _
+ (dump-dependency-info)
(primitive-exit 1))
(lambda args
;; Try to report the error in an intelligible way.
diff --git a/guix/build/compile.scm b/guix/build/compile.scm
index b86ec3b743..c259b27abf 100644
--- a/guix/build/compile.scm
+++ b/guix/build/compile.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -29,14 +30,27 @@
#:use-module (guix build utils)
#:use-module (language tree-il optimize)
#:use-module (language cps optimize)
- #:export (compile-files))
+ #:export (compile-files notice-dependency current-dependency-info))
;;; Commentary:
;;;
-;;; Support code to compile Guile code as efficiently as possible (with 2.2).
+;;; Support code to compile Guile code as efficiently as possible (with 2.2)
+;;; and keep track of the dependencies of compiled files.
;;;
;;; Code:
+(define current-dependency-info (make-parameter #f))
+(define current-output-file (make-parameter #f))
+
+(define (notice-dependency dependency)
+ "Add the file DEPENDENCY to the list of dependencies of the compiled file
+that is being computed, if any."
+ (define dependency-table (current-dependency-info))
+ (define output (current-output-file))
+ (when (and dependency-table output)
+ (hash-set! dependency-table output
+ (cons dependency (hash-ref dependency-table output '())))))
+
(define optimizations-for-level
(or (and=> (false-if-exception
(resolve-interface '(system base optimize)))
@@ -207,12 +221,27 @@ files are for HOST, a GNU triplet such as \"x86_64-linux-gnu\"."
;; Exit as soon as something goes wrong.
(exit-on-exception
file
- (let ((relative (relative-file source-directory file)))
- (compile-file file
- #:output-file (string-append build-directory "/"
- (scm->go relative))
- #:opts (append warning-options
- (optimization-options relative))))))
+ (let* ((relative (relative-file source-directory file))
+ (output-file (string-append build-directory "/"
+ (scm->go relative))))
+ (parameterize ((current-output-file output-file))
+ (when (current-dependency-info)
+ ;; If dependency information is being tracked, remove
+ ;; the old compiled file first. Otherwise, if recompiling
+ ;; the file due to an updated dependency causes an exception,
+ ;; the new dependency information won't include the compiled
+ ;; file and therefore the old compiled file would be considered
+ ;; up-to-date on the following "make" run.
+ (when (file-exists? output-file)
+ (delete-file output-file))
+ ;; Remove the old dependency information, otherwise
+ ;; the dependency information table will keep growing
+ ;; after each "make" run.
+ (hash-remove! (current-dependency-info) output-file))
+ (compile-file file
+ #:output-file output-file
+ #:opts (append warning-options
+ (optimization-options relative)))))))
(with-augmented-search-path %load-path source-directory
(with-augmented-search-path %load-compiled-path build-directory
--
2.33.0
[-- Attachment #1.10: 0009-packages-Add-patches-to-the-dependency-list-of-packa.patch --]
[-- Type: text/x-patch, Size: 1490 bytes --]
From d9c3ffce927782ce2ef8943784f0e7b5cd466fec Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sun, 5 Sep 2021 17:15:08 +0200
Subject: [PATCH 09/10] packages: Add patches to the dependency list of package
modules.
* gnu/packages.scm (search-patch): Call 'notice-dependency' on
the patch file.
---
gnu/packages.scm | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
diff --git a/gnu/packages.scm b/gnu/packages.scm
index f5552e5a9b..39929ae022 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -34,6 +34,8 @@
#:select ((package-name->name+version
. hyphen-separated-name->name+version)
mkdir-p))
+ ;; only required at expansion time
+ #:autoload (guix build compile) (notice-dependency)
#:use-module (guix profiles)
#:use-module (guix describe)
#:use-module (guix deprecation)
@@ -121,7 +123,10 @@ if possible. Return #f if not found."
;; in advance.
(let ((patch (try-search-patch (syntax->datum #'file-name))))
(if patch
- #`(%local-patch-file file-name #,(file-hash* patch #:select? true))
+ (begin
+ (notice-dependency patch)
+ #`(%local-patch-file file-name
+ #,(file-hash* patch #:select? true)))
(begin
(warning (source-properties->location
(syntax-source #'file-name))
--
2.33.0
[-- Attachment #1.11: 0010-gexp-Do-not-intern-if-the-file-is-already-in-the-sto.patch --]
[-- Type: text/x-patch, Size: 2875 bytes --]
From d359fefabf2831e42aea6edf646a9e0373be5d0f Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 4 Sep 2021 18:10:32 +0200
Subject: [PATCH 10/10] gexp: Do not intern if the file is already in the
store.
* guix/gexp.scm (local-file-compiler): When the file is already in the
store, re-use the fixed output path instead of interning the file
again.
* guix/gexp.scm (add-temp-root-and-valid-path?*): New procedure.
---
guix/gexp.scm | 32 +++++++++++++++++++++++++-------
1 file changed, 25 insertions(+), 7 deletions(-)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index c69e4aa299..20c9d93170 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -528,16 +528,34 @@ appears."
'system-error' exception is raised if FILE could not be found."
(force (%local-file-absolute-file-name file)))
+(define add-temp-root-and-valid-path?* (store-lift add-temp-root-and-valid-path?))
+
(define-gexp-compiler (local-file-compiler (file <local-file>) system target)
;; "Compile" FILE by adding it to the store.
(match file
- (($ <local-file> file (= force absolute) name sha256 recursive? select?)
- ;; Canonicalize FILE so that if it's a symlink, it is resolved. Failing
- ;; to do that, when RECURSIVE? is #t, we could end up creating a dangling
- ;; symlink in the store, and when RECURSIVE? is #f 'add-to-store' would
- ;; just throw an error, both of which are inconvenient.
- (interned-file absolute name
- #:recursive? recursive? #:select? select?))))
+ ;; Delay computing the absolute file name until 'intern', as this
+ ;; might be a relatively expensive computation (e.g. if search-patch
+ ;; is used), especially on a spinning disk.
+ (($ <local-file> file absolute-promise name sha256 recursive? select?)
+ (let ()
+ (define (intern)
+ ;; Canonicalize FILE so that if it's a symlink, it is resolved.
+ ;; Failing to do that, when RECURSIVE? is #t, we could end up creating
+ ;; a dangling symlink in the store, and when RECURSIVE? is #f
+ ;; 'add-to-store' would just throw an error, both of which are
+ ;; inconvenient.
+ (interned-file (force absolute-promise) name
+ #:recursive? recursive? #:select? select?))
+ ;; If the hash is known in advance and the store already has the
+ ;; item, there is no need to intern the file.
+ (if sha256
+ (let ((path (fixed-output-path name sha256 #:recursive? recursive?)))
+ (mlet %store-monad ((valid? (add-temp-root-and-valid-path?* path)))
+ (if valid?
+ (return path)
+ (intern))))
+ ;; If PATH does not yet exist, fall back to interning.
+ (intern))))))
(define-record-type <plain-file>
(%plain-file name content references)
--
2.33.0
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply related [flat|nested] 16+ messages in thread
* bug#50384: [PATCH v3] Optimise search-patch (reducing I/O)
2021-09-09 20:25 ` [bug#50384] [PATCH v3] " Maxime Devos
@ 2021-09-10 9:54 ` Maxime Devos
0 siblings, 0 replies; 16+ messages in thread
From: Maxime Devos @ 2021-09-10 9:54 UTC (permalink / raw)
To: 50384-done; +Cc: Ludovic Courtès, zimoun
[-- Attachment #1: Type: text/plain, Size: 120 bytes --]
It doesn't seem like the patch series is going
to end up improving anything, so I'm closing it.
Greetings,
Maxime
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 16+ messages in thread
* [bug#50384] [PATCH v4] Optimise search-patch (reducing I/O)
2021-09-09 14:51 ` [bug#50384] [PATCH] " Ludovic Courtès
@ 2021-09-21 16:55 ` Ludovic Courtès
2021-09-23 17:26 ` Maxime Devos
0 siblings, 1 reply; 16+ messages in thread
From: Ludovic Courtès @ 2021-09-21 16:55 UTC (permalink / raw)
To: Maxime Devos; +Cc: 50384
[-- Attachment #1: Type: text/plain, Size: 3722 bytes --]
Hi!
I took the liberty to reopen this patch because there were good ideas
IMO. I’m sorry if my many questions and lack of responsiveness came out
as a suggestion that this approach wasn’t good.
Ludovic Courtès <ludo@gnu.org> skribis:
>> +;; repeated 'stat' calls. Allow computing the hash of the file in advance,
>> +;; to avoid having to send the file to the daemon when it is already interned
>> +;; in the store.
>> (define-record-type <local-file>
>> - (%%local-file file absolute name recursive? select?)
>> + (%%local-file file absolute name sha256 recursive? select?)
>> local-file?
>> (file local-file-file) ;string
>> (absolute %local-file-absolute-file-name) ;promise string
>> (name local-file-name) ;string
>> + (sha256 local-file-sha256) ;sha256 bytevector | #f
>
> Could we store the result of ‘fixed-output-path’ rather than the SHA256,
> while we’re at it?
I tried that with the patch below, roughly taking the same approach as
your patch series, but somewhat simplified, mostly so I could
experiment.
I changed just a few files to use the new ‘local-patches’ instead of
‘search-patches’ (I thought it might make sense to introduce a new
macro, to make it clear that ‘%package-module-path’ is not used at all).
The end result is that it works as intended :-), but it’s actually a
tiny bit slower: on a cache hit, we do 2 RPCs (add-temp-root +
valid-path?) instead of 1 (add-to-store). The extra round-trip is more
expensive than the I/O we’re saving, at least on my laptop (with SSD; it
might be different with slower disk I/O and/or when talking to a remote
daemon, as on clusters.)
Now, this could be addressed by adding an ‘add-temp-root-if-valid’ RPC,
which would do both in one.
We can estimate the performance of that strategy by commenting out the
‘add-temp-root*’ call (thus getting a single RPC) in
‘local-file-compiler’: this time it’s slightly faster, but we’re in the
1% range on the wall-clock time of ‘guix build pigx -d --no-grafts’:
--8<---------------cut here---------------start------------->8---
$ time GUIX_DISABLE_LOCAL_FILE_CACHE=t ./pre-inst-env guix build pigx -d --no-grafts
/gnu/store/dqaknknlsw8a97xwjrhhd1g4jg71jqg7-pigx-0.0.3.drv
real 0m3.488s
user 0m3.718s
sys 0m0.132s
$ time GUIX_DISABLE_LOCAL_FILE_CACHE=t ./pre-inst-env guix build pigx -d --no-grafts
/gnu/store/dqaknknlsw8a97xwjrhhd1g4jg71jqg7-pigx-0.0.3.drv
real 0m3.501s
user 0m3.722s
sys 0m0.138s
$ time ./pre-inst-env guix build pigx -d --no-grafts
/gnu/store/dqaknknlsw8a97xwjrhhd1g4jg71jqg7-pigx-0.0.3.drv
real 0m3.437s
user 0m3.622s
sys 0m0.174s
$ time ./pre-inst-env guix build pigx -d --no-grafts
/gnu/store/dqaknknlsw8a97xwjrhhd1g4jg71jqg7-pigx-0.0.3.drv
real 0m3.492s
user 0m3.708s
sys 0m0.151s
--8<---------------cut here---------------end--------------->8---
Perhaps the gains would be a bit higher if we change all the package
files to use ‘local-patches’, but we probably can’t expect a lot more
anyway since that process is CPU-bound.
So I don’t know. It feels like a worthy optimization, and one that’s
manageable from a maintenance viewpoint, but it buys us very little.
Thoughts?
Looking at the big picture, what I’d like to have is a package
derivation cache designed in such a way that “guix install foo” wouldn’t
even need to load any package module on a cache hit. That’d make a
noticeable difference performance-wise, that’s another level of
complexity… (I have a rough design in mind that we could discuss.)
Ludo’.
[-- Attachment #2: Type: text/x-patch, Size: 27716 bytes --]
diff --git a/gnu/packages.scm b/gnu/packages.scm
index ccfc83dd11..4e7045e605 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com>
@@ -34,6 +34,7 @@
#:use-module (guix profiles)
#:use-module (guix describe)
#:use-module (guix deprecation)
+ #:use-module (guix gexp)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
#:use-module (ice-9 binary-ports)
@@ -46,6 +47,7 @@
#:use-module (srfi srfi-39)
#:export (search-patch
search-patches
+ local-patches
search-auxiliary-file
%patch-path
%auxiliary-files-path
@@ -101,6 +103,17 @@
FILE-NAME found in %PATCH-PATH."
(list (search-patch file-name) ...))
+(define-syntax local-patches
+ (lambda (s)
+ (syntax-case s ()
+ ((_ files ...)
+ (let ((scoped (map (lambda (file)
+ (string-append "patches/" file))
+ (syntax->datum #'(files ...)))))
+ (with-syntax (((scoped ...) (datum->syntax #'x scoped)))
+ #`(list (local-file scoped #:recursive? #t)
+ ...)))))))
+
(define %distro-root-directory
;; Absolute file name of the module hierarchy. Since (gnu packages …) might
;; live in a directory different from (guix), try to get the best match.
diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm
index ea2e102c15..b449b5c2b5 100644
--- a/gnu/packages/base.scm
+++ b/gnu/packages/base.scm
@@ -106,7 +106,7 @@ command-line arguments, multiple languages, and so on.")
(sha256
(base32
"1yy33kiwrxrwj2nxa4fg15bvmwyghqbs8qwkdvy5phm784f7brjq"))
- (patches (search-patches "grep-timing-sensitive-test.patch"))))
+ (patches (local-patches "grep-timing-sensitive-test.patch"))))
(build-system gnu-build-system)
(native-inputs `(("perl" ,perl))) ;some of the tests require it
(inputs `(("pcre" ,pcre)))
@@ -187,7 +187,7 @@ implementation offers several extensions over the standard utility.")
(sha256
(base32
"1n7xy657ii0sa42zx6944v2m4v9qrh6sqgmw17l3nch3y43sxlyh"))
- (patches (search-patches "tar-skip-unreliable-tests.patch"
+ (patches (local-patches "tar-skip-unreliable-tests.patch"
"tar-remove-wholesparse-check.patch"))))
(build-system gnu-build-system)
;; Note: test suite requires ~1GiB of disk space.
@@ -245,7 +245,7 @@ standard utility.")
(sha256
(base32
"1zfqy4rdcy279vwn2z1kbv19dcfw25d2aqy9nzvdkq5bjzd0nqdc"))
- (patches (search-patches "patch-hurd-path-max.patch"))))
+ (patches (local-patches "patch-hurd-path-max.patch"))))
(build-system gnu-build-system)
(arguments
;; Work around a cross-compilation bug whereby libpatch.a would provide
@@ -298,7 +298,7 @@ interactive means to merge two files.")
(sha256
(base32
"16kqz9yz98dasmj70jwf5py7jk558w96w0vgp3zf9xsqk3gzpzn5"))
- (patches (search-patches "findutils-localstatedir.patch"
+ (patches (local-patches "findutils-localstatedir.patch"
"findutils-test-rwlock-threads.patch"))))
(build-system gnu-build-system)
(arguments
@@ -335,7 +335,7 @@ used to apply commands with arbitrarily long arguments.")
(sha256
(base32
"1yjcrh5hw70c0yn8zw55pd6j51dj90anpq8mmg649ps9g3gdhn24"))
- (patches (search-patches "coreutils-ls.patch"))))
+ (patches (local-patches "coreutils-ls.patch"))))
(build-system gnu-build-system)
(inputs `(("acl" ,acl) ; TODO: add SELinux
("gmp" ,gmp) ;bignums in 'expr', yay!
@@ -450,7 +450,7 @@ standard.")
(sha256
(base32
"06cfqzpqsvdnsxbysl5p2fgdgxgl9y4p7scpnrfa8z2zgkjdspz0"))
- (patches (search-patches "make-impure-dirs.patch"))))
+ (patches (local-patches "make-impure-dirs.patch"))))
(build-system gnu-build-system)
(native-inputs `(("pkg-config" ,pkg-config))) ; to detect Guile
(inputs `(("guile" ,guile-3.0)))
@@ -518,7 +518,7 @@ change. GNU make offers many powerful extensions over the standard utility.")
(sha256
(base32
"1rin1f5c7wm4n3piky6xilcrpf2s0n3dd5vqq8irrxkcic3i1w49"))
- (patches (search-patches "binutils-loongson-workaround.patch"))))
+ (patches (local-patches "binutils-loongson-workaround.patch"))))
(build-system gnu-build-system)
;; TODO: Add dependency on zlib + those for Gold.
@@ -722,7 +722,7 @@ the store.")
"use_ldconfig=no"))
#t))
(modules '((guix build utils)))
- (patches (search-patches "glibc-ldd-x86_64.patch"
+ (patches (local-patches "glibc-ldd-x86_64.patch"
"glibc-hidden-visibility-ldconfig.patch"
"glibc-versioned-locpath.patch"
"glibc-allow-kernel-2.6.32.patch"
@@ -938,7 +938,7 @@ the store.")
("python" ,python-minimal)
,@(if (target-powerpc?)
- `(("powerpc64le-patch" ,@(search-patches
+ `(("powerpc64le-patch" ,@(local-patches
"glibc-ldd-powerpc.patch")))
'())
,@(if (hurd-target?)
@@ -979,7 +979,7 @@ with the Linux kernel.")
(sha256
(base32
"1bxqpg91d02qnaz837a5kamm0f43pr1il4r9pknygywsar713i72"))
- (patches (search-patches "glibc-ldd-x86_64.patch"
+ (patches (local-patches "glibc-ldd-x86_64.patch"
"glibc-CVE-2019-19126.patch"
"glibc-hidden-visibility-ldconfig.patch"
"glibc-versioned-locpath.patch"
@@ -997,7 +997,7 @@ with the Linux kernel.")
(sha256
(base32
"0jzh58728flfh939a8k9pi1zdyalfzlxmwra7k0rzji5gvavivpk"))
- (patches (search-patches "glibc-ldd-x86_64.patch"
+ (patches (local-patches "glibc-ldd-x86_64.patch"
"glibc-CVE-2019-7309.patch"
"glibc-CVE-2019-9169.patch"
"glibc-2.29-git-updates.patch"
@@ -1017,7 +1017,7 @@ with the Linux kernel.")
(sha256
(base32
"10iha5ynvdj5m62vgpgqbq4cwvc2yhyl2w9yyyjgfxmdmx8h145i"))
- (patches (search-patches "glibc-ldd-x86_64.patch"
+ (patches (local-patches "glibc-ldd-x86_64.patch"
"glibc-2.28-git-fixes.patch"
"glibc-hidden-visibility-ldconfig.patch"
"glibc-versioned-locpath.patch"
@@ -1036,7 +1036,7 @@ with the Linux kernel.")
(sha256
(base32
"0wpwq7gsm7sd6ysidv0z575ckqdg13cr2njyfgrbgh4f65adwwji"))
- (patches (search-patches "glibc-ldd-x86_64.patch"
+ (patches (local-patches "glibc-ldd-x86_64.patch"
"glibc-2.27-git-fixes.patch"
"glibc-hidden-visibility-ldconfig.patch"
"glibc-versioned-locpath.patch"
diff --git a/gnu/packages/bioinformatics.scm b/gnu/packages/bioinformatics.scm
index 2b67cab609..d35179f5bc 100644
--- a/gnu/packages/bioinformatics.scm
+++ b/gnu/packages/bioinformatics.scm
@@ -5108,7 +5108,7 @@ form of assemblies or reads.")
(sha256
(base32
"0hyg2smw1nz69mfvjpk45xyyychmda92c80a0cv7baji84ri4iyn"))
- (patches (search-patches "metabat-fix-compilation.patch"))))
+ (patches (local-patches "metabat-fix-compilation.patch"))))
(build-system scons-build-system)
(arguments
`(#:scons ,scons-python2
@@ -6232,7 +6232,7 @@ Roche 454, Ion Torrent and Pacific BioSciences SMRT.")
(sha256
(base32
"1n2s5wvvj2y0vfgjkg1q11xahpbagxz7h2vf5q7qyy25s12kbzbd"))
- (patches (search-patches "mosaicatcher-unbundle-htslib.patch"))))
+ (patches (local-patches "mosaicatcher-unbundle-htslib.patch"))))
(build-system cmake-build-system)
(arguments
`(#:tests? #false ; there are no tests
@@ -6454,7 +6454,7 @@ accessed/downloaded on demand across HTTP.")
version "-src.zip"))
(sha256
(base32 "0as8gxm4pjyc8dxmm1sl873rrd7wn5qs0l29nqfnl31x8i467xaa"))
- (patches (search-patches "plink-1.07-unclobber-i.patch"
+ (patches (local-patches "plink-1.07-unclobber-i.patch"
"plink-endian-detection.patch"))))
(build-system gnu-build-system)
(arguments
@@ -7705,7 +7705,7 @@ includes software to
(sha256
(base32
"0vhrpjfdf75ba04b24xknp41790cvcgwl0vgpy7qbzj5xh2521ss"))
- (patches (search-patches "vsearch-unbundle-cityhash.patch"))
+ (patches (local-patches "vsearch-unbundle-cityhash.patch"))
(snippet
'(begin
;; Remove bundled cityhash sources. The vsearch source is adjusted
diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm
index e7bd6cf002..237540d7e3 100644
--- a/gnu/packages/commencement.scm
+++ b/gnu/packages/commencement.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014, 2015, 2017 Mark H Weaver <mhw@netris.org>
@@ -2115,7 +2115,7 @@ ac_cv_c_float_format='IEEE (little-endian)'
(method url-fetch)
(uri (string-append "mirror://gnu/binutils/binutils-"
version ".tar.bz2"))
- (patches (search-patches "binutils-boot-2.20.1a.patch"))
+ (patches (local-patches "binutils-boot-2.20.1a.patch"))
(sha256
(base32
"0r7dr0brfpchh5ic0z9r4yxqn4ybzmlh25sbp30cacqk8nb7rlvi")))))
@@ -2191,7 +2191,7 @@ ac_cv_c_float_format='IEEE (little-endian)'
(uri (string-append "mirror://gnu/glibc/glibc-"
version
".tar.gz"))
- (patches (search-patches "glibc-boot-2.16.0.patch"
+ (patches (local-patches "glibc-boot-2.16.0.patch"
"glibc-bootstrap-system-2.16.0.patch"))
(sha256
(base32
@@ -3317,7 +3317,7 @@ memoized as a function of '%current-system'."
("perl" ,perl-boot0)
("python" ,python-boot0)
,@(if (target-powerpc?)
- `(("powerpc64le-patch" ,@(search-patches
+ `(("powerpc64le-patch" ,@(local-patches
"glibc-ldd-powerpc.patch")))
'())))
(inputs
@@ -3471,7 +3471,7 @@ exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
;; This time we need 'msgfmt' to install all the libc.mo files.
(native-inputs `(,@(package-native-inputs glibc-final-with-bootstrap-bash)
,@(if (target-powerpc?)
- `(("powerpc64le-patch" ,@(search-patches
+ `(("powerpc64le-patch" ,@(local-patches
"glibc-ldd-powerpc.patch")))
'())
("gettext" ,gettext-boot0)))
diff --git a/gnu/packages/gcc.scm b/gnu/packages/gcc.scm
index 493ff2659f..1576b90503 100644
--- a/gnu/packages/gcc.scm
+++ b/gnu/packages/gcc.scm
@@ -155,7 +155,7 @@ where the OS part is overloaded to denote a specific ABI---into GCC
(sha256
(base32
"10k2k71kxgay283ylbbhhs51cl55zn2q38vj5pk4k950qdnirrlj"))
- (patches (search-patches "gcc-4-compile-with-gcc-5.patch"
+ (patches (local-patches "gcc-4-compile-with-gcc-5.patch"
"gcc-fix-texi2pod.patch"))))
(build-system gnu-build-system)
@@ -380,7 +380,7 @@ Go. It also includes runtime support libraries for these languages.")
(sha256
(base32
"08yggr18v373a1ihj0rg2vd6psnic42b518xcgp3r9k81xz1xyr2"))
- (patches (search-patches "gcc-arm-link-spec-fix.patch"
+ (patches (local-patches "gcc-arm-link-spec-fix.patch"
"gcc-4.8-libsanitizer-fix.patch"
"gcc-asan-missing-include.patch"
"gcc-fix-texi2pod.patch"))
@@ -413,7 +413,7 @@ Go. It also includes runtime support libraries for these languages.")
(sha256
(base32
"14l06m7nvcvb0igkbip58x59w3nq6315k6jcz3wr9ch1rn9d44bc"))
- (patches (search-patches "gcc-4.9-libsanitizer-fix.patch"
+ (patches (local-patches "gcc-4.9-libsanitizer-fix.patch"
"gcc-4.9-libsanitizer-ustat.patch"
"gcc-4.9-libsanitizer-mode-size.patch"
"gcc-arm-bug-71399.patch"
@@ -475,7 +475,7 @@ Go. It also includes runtime support libraries for these languages.")
(sha256
(base32
"11zd1hgzkli3b2v70qsm2hyqppngd4616qc96lmm9zl2kl9yl32k"))
- (patches (search-patches "gcc-arm-bug-71399.patch"
+ (patches (local-patches "gcc-arm-bug-71399.patch"
"gcc-libsanitizer-ustat.patch"
"gcc-strmov-store-file-names.patch"
"gcc-5.0-libvtv-runpath.patch"
@@ -514,7 +514,7 @@ Go. It also includes runtime support libraries for these languages.")
(sha256
(base32
"0i89fksfp6wr1xg9l8296aslcymv2idn60ip31wr9s4pwin7kwby"))
- (patches (search-patches "gcc-strmov-store-file-names.patch"
+ (patches (local-patches "gcc-strmov-store-file-names.patch"
"gcc-6-libsanitizer-mode-size.patch"
"gcc-6-source-date-epoch-1.patch"
"gcc-6-source-date-epoch-2.patch"
@@ -544,7 +544,7 @@ Go. It also includes runtime support libraries for these languages.")
(sha256
(base32
"0qg6kqc5l72hpnj4vr6l0p69qav0rh4anlkk3y55540zy3klc6dq"))
- (patches (search-patches "gcc-strmov-store-file-names.patch"
+ (patches (local-patches "gcc-strmov-store-file-names.patch"
"gcc-7-libsanitizer-mode-size.patch"
"gcc-5.0-libvtv-runpath.patch"))))
(description
@@ -563,7 +563,7 @@ It also includes runtime support libraries for these languages.")))
(sha256
(base32
"0l7d4m9jx124xsk6xardchgy2k5j5l2b15q322k31f0va4d8826k"))
- (patches (search-patches "gcc-8-strmov-store-file-names.patch"
+ (patches (local-patches "gcc-8-strmov-store-file-names.patch"
"gcc-5.0-libvtv-runpath.patch"
"gcc-8-sort-libtool-find-output.patch"))))))
@@ -578,7 +578,7 @@ It also includes runtime support libraries for these languages.")))
(sha256
(base32
"13l3p6g2krilaawbapmn9zmmrh3zdwc36mfr3msxfy038hps6pf9"))
- (patches (search-patches "gcc-9-strmov-store-file-names.patch"
+ (patches (local-patches "gcc-9-strmov-store-file-names.patch"
"gcc-9-asan-fix-limits-include.patch"
"gcc-5.0-libvtv-runpath.patch"))))))
@@ -593,7 +593,7 @@ It also includes runtime support libraries for these languages.")))
(sha256
(base32
"0i6378ig6h397zkhd7m4ccwjx5alvzrf2hm27p1pzwjhlv0h9x34"))
- (patches (search-patches "gcc-9-strmov-store-file-names.patch"
+ (patches (local-patches "gcc-9-strmov-store-file-names.patch"
"gcc-5.0-libvtv-runpath.patch"))))))
(define-public gcc-11
@@ -607,7 +607,7 @@ It also includes runtime support libraries for these languages.")))
(sha256
(base32
"12zs6vd2rapp42x154m479hg3h3lsafn3xhg06hp5hsldd9xr3nh"))
- (patches (search-patches "gcc-9-strmov-store-file-names.patch"
+ (patches (local-patches "gcc-9-strmov-store-file-names.patch"
"gcc-5.0-libvtv-runpath.patch"))))))
;; Note: When changing the default gcc version, update
@@ -1129,7 +1129,7 @@ dependence analysis and bounds on piecewise step-polynomials.")
(sha256
(base32
"13d9cqa5rzhbjq0xf0b2dyxag7pqa72xj9dhsa03m8ccr1a4npq9"))
- (patches (search-patches "isl-0.11.1-aarch64-support.patch"))))))
+ (patches (local-patches "isl-0.11.1-aarch64-support.patch"))))))
(define-public cloog
(package
diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm
index 3bb57ee2bd..413c3cb01e 100644
--- a/gnu/packages/python.scm
+++ b/gnu/packages/python.scm
@@ -116,7 +116,7 @@
(sha256
(base32
"0hds28cg226m8j8sr394nm9yc4gxhvlv109w0avsf2mxrlrz0hsd"))
- (patches (search-patches "python-2.7-search-paths.patch"
+ (patches (local-patches "python-2.7-search-paths.patch"
"python-2-deterministic-build-info.patch"
"python-2.7-site-prefixes.patch"
"python-2.7-source-date-epoch.patch"
@@ -370,7 +370,7 @@ data types.")
(method url-fetch)
(uri (string-append "https://www.python.org/ftp/python/"
version "/Python-" version ".tar.xz"))
- (patches (search-patches
+ (patches (local-patches
"python-CVE-2020-26116.patch"
"python-3.8-CVE-2021-3177.patch"
"python-3-fix-tests.patch"
@@ -531,7 +531,7 @@ data types.")
(method url-fetch)
(uri (string-append "https://www.python.org/ftp/python/"
version "/Python-" version ".tar.xz"))
- (patches (search-patches
+ (patches (local-patches
"python-3.9-fix-tests.patch"
"python-3-deterministic-build-info.patch"
"python-3-search-paths.patch"))
diff --git a/guix/gexp.scm b/guix/gexp.scm
index f3d278b3e6..830fea6c1d 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -30,12 +30,15 @@
#:use-module (guix diagnostics)
#:use-module (guix i18n)
#:use-module (rnrs bytevectors)
+ #:autoload (gcrypt hash) (file-sha256 open-sha256-port)
+ #:autoload (guix serialization) (write-file)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
+ #:use-module (srfi srfi-71)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:export (gexp
@@ -59,6 +62,7 @@
local-file-name
local-file-recursive?
local-file-select?
+ local-file-cache-authoritative?
plain-file
plain-file?
@@ -421,27 +425,30 @@ Here TARGET is bound to the cross-compilation triplet or #f."
;; absolute file name. We keep it in a promise to compute it lazily and avoid
;; repeated 'stat' calls.
(define-record-type <local-file>
- (%%local-file file absolute name recursive? select?)
+ (%%local-file file absolute name recursive? select?
+ store-file)
local-file?
(file local-file-file) ;string
(absolute %local-file-absolute-file-name) ;promise string
(name local-file-name) ;string
(recursive? local-file-recursive?) ;Boolean
- (select? local-file-select?)) ;string stat -> Boolean
+ (select? local-file-select?) ;string stat -> Boolean
+ (store-file local-file-store-file)) ;string | #f
(define (true file stat) #t)
(define* (%local-file file promise #:optional (name (basename file))
#:key
(literal? #t) location
- recursive? (select? true))
+ recursive? (select? true) store-file)
;; This intermediate procedure is part of our ABI, but the underlying
;; %%LOCAL-FILE is not.
(when (and (not literal?) (not (string-prefix? "/" file)))
(warning (and=> location source-properties->location)
(G_ "resolving '~a' relative to current directory~%")
file))
- (%%local-file file promise name recursive? select?))
+ (%%local-file file promise name recursive? select?
+ store-file))
(define (absolute-file-name file directory)
"Return the canonical absolute file name for FILE, which lives in the
@@ -451,7 +458,7 @@ vicinity of DIRECTORY."
((not directory) file)
((string-prefix? "/" directory)
(string-append directory "/" file))
- (else file))))
+ (else (string-append directory "/" file)))))
(define-syntax-rule (assume-valid-file-name file)
"This is a syntactic keyword to tell 'local-file' that it can assume that
@@ -477,13 +484,43 @@ where FILE is the entry's absolute file name and STAT is the result of
This is the declarative counterpart of the 'interned-file' monadic procedure.
It is implemented as a macro to capture the current source directory where it
appears."
+ (define (store-file-name file recursive?)
+ (pk 'f-o-p file recursive?
+ (fixed-output-path (basename file)
+ (if recursive?
+ (let ((port get-hash (open-sha256-port)))
+ (write-file file port)
+ (force-output port)
+ (get-hash))
+ (file-sha256 file))
+ #:hash-algo 'sha256
+ #:recursive? recursive?)))
+
(syntax-case s (assume-valid-file-name)
((_ file rest ...)
(string? (syntax->datum #'file))
;; FILE is a literal, so resolve it relative to the source directory.
- #'(%local-file file
- (delay (absolute-file-name file (current-source-directory)))
- rest ...))
+ (let* ((directory (and=> (syntax-source s)
+ (lambda (properties)
+ (and=> (assq-ref properties 'filename) dirname))))
+ (absolute (and directory
+ (absolute-file-name (syntax->datum #'file)
+ directory)))
+ (recursive? (equal? '(#:recursive? #t)
+ (syntax->datum #'(rest ...))))
+ (store-file (and absolute
+ (or recursive?
+ (null? (syntax->datum #'(rest ...))))
+ (catch 'system-error
+ (lambda ()
+ (store-file-name absolute recursive?))
+ (const #f)))))
+ #`(%local-file file
+ (delay (absolute-file-name file (current-source-directory)))
+ #,@(if store-file
+ #`(#:store-file #,store-file)
+ #'())
+ rest ...)))
((_ (assume-valid-file-name file) rest ...)
;; FILE is not a literal, so resolve it relative to the current
;; directory. Since the user declared FILE is valid, do not pass
@@ -514,16 +551,34 @@ appears."
'system-error' exception is raised if FILE could not be found."
(force (%local-file-absolute-file-name file)))
+(define valid-path?*
+ (store-lift valid-path?))
+(define add-temp-root*
+ (store-lift add-temp-root))
+
+(define local-file-cache-authoritative?
+ (make-parameter (and (not (getenv "GUIX_DISABLE_LOCAL_FILE_CACHE"))
+ #;(not (getenv "GUIX_UNINSTALLED")))))
+
(define-gexp-compiler (local-file-compiler (file <local-file>) system target)
;; "Compile" FILE by adding it to the store.
(match file
- (($ <local-file> file (= force absolute) name recursive? select?)
+ (($ <local-file> file absolute name recursive? select?
+ store-file)
;; Canonicalize FILE so that if it's a symlink, it is resolved. Failing
;; to do that, when RECURSIVE? is #t, we could end up creating a dangling
;; symlink in the store, and when RECURSIVE? is #f 'add-to-store' would
;; just throw an error, both of which are inconvenient.
- (interned-file absolute name
- #:recursive? recursive? #:select? select?))))
+ (mlet %store-monad ((valid? (if (and store-file
+ (local-file-cache-authoritative?))
+ (mbegin %store-monad
+ ;; (add-temp-root* store-file)
+ (valid-path?* store-file))
+ (return #f))))
+ (if valid?
+ (return store-file)
+ (interned-file (force absolute) name
+ #:recursive? recursive? #:select? select?))))))
(define-record-type <plain-file>
(%plain-file name content references)
^ permalink raw reply related [flat|nested] 16+ messages in thread
* [bug#50384] [PATCH v4] Optimise search-patch (reducing I/O)
2021-09-21 16:55 ` [bug#50384] [PATCH v4] " Ludovic Courtès
@ 2021-09-23 17:26 ` Maxime Devos
2021-09-27 16:17 ` Ludovic Courtès
0 siblings, 1 reply; 16+ messages in thread
From: Maxime Devos @ 2021-09-23 17:26 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 50384
[-- Attachment #1: Type: text/plain, Size: 3283 bytes --]
Ludovic Courtès schreef op di 21-09-2021 om 18:55 [+0200]:
> Hi!
>
> I took the liberty to reopen this patch because there were good ideas
> IMO. I’m sorry if my many questions and lack of responsiveness came out
> as a suggestion that this approach wasn’t good.
I reordered your mail a little.
> Looking at the big picture, what I’d like to have is a package
> derivation cache designed in such a way that “guix install foo” wouldn’t
> even need to load any package module on a cache hit. That’d make a
> noticeable difference performance-wise, that’s another level of
> complexity… (I have a rough design in mind that we could discuss.)
This ‘package derivation cache’ seems an interesting idea to pursue,
though I wonder what could be used as ‘keys’ in the derivation cache.
Package names aren't sufficient because packages can have multiple versions,
package names + package versions aren't sufficient because packages can have
multiple variants. Grafts might need some care. Having multiple versions of
guix can be addressed by including the commits of every channel in the key.
Even if ‘foo’ isn't in the cache, the cache can still be useful if the
inputs ‘bar’ and ‘baz’ of foo are in the cache.
> Ludovic Courtès <ludo@gnu.org> skribis:
>
> > > +;; repeated 'stat' calls. Allow computing the hash of the file in advance,
> > > +;; to avoid having to send the file to the daemon when it is already interned
> > > +;; in the store.
> > > (define-record-type <local-file>
> > > - (%%local-file file absolute name recursive? select?)
> > > + (%%local-file file absolute name sha256 recursive? select?)
> > > local-file?
> > > (file local-file-file) ;string
> > > (absolute %local-file-absolute-file-name) ;promise string
> > > (name local-file-name) ;string
> > > + (sha256 local-file-sha256) ;sha256 bytevector | #f
> >
> > Could we store the result of ‘fixed-output-path’ rather than the SHA256,
> > while we’re at it?
Embedding the result of ‘fixed-output-path’ in the .go might be problematic
from a closure size perspective, as that would create additional references in the
store items of guix.
> I tried that with the patch below, roughly taking the same approach as
> your patch series, but somewhat simplified, mostly so I could
> experiment. [...]
>
> We can estimate the performance of that strategy by commenting out the
> ‘add-temp-root*’ call (thus getting a single RPC) in
> ‘local-file-compiler’: this time it’s slightly faster, but we’re in the
> 1% range on the wall-clock time of ‘guix build pigx -d --no-grafts’:
> [...]
> Perhaps the gains would be a bit higher if we change all the package
> files to use ‘local-patches’, but we probably can’t expect a lot more
> anyway since that process is CPU-bound.
>
> So I don’t know. It feels like a worthy optimization, and one that’s
> manageable from a maintenance viewpoint, but it buys us very little.
>
> Thoughts?
As it is only <1%, I would prefer trying the ‘package derivation cache’
first, as it seems to have more potential.
> Ludo’.
>
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 16+ messages in thread
* [bug#50384] [PATCH v4] Optimise search-patch (reducing I/O)
2021-09-23 17:26 ` Maxime Devos
@ 2021-09-27 16:17 ` Ludovic Courtès
2021-10-04 16:46 ` [bug#50384] [PATCH] " zimoun
0 siblings, 1 reply; 16+ messages in thread
From: Ludovic Courtès @ 2021-09-27 16:17 UTC (permalink / raw)
To: Maxime Devos; +Cc: 50384
Hi,
Maxime Devos <maximedevos@telenet.be> skribis:
> Ludovic Courtès schreef op di 21-09-2021 om 18:55 [+0200]:
[...]
>> Looking at the big picture, what I’d like to have is a package
>> derivation cache designed in such a way that “guix install foo” wouldn’t
>> even need to load any package module on a cache hit. That’d make a
>> noticeable difference performance-wise, that’s another level of
>> complexity… (I have a rough design in mind that we could discuss.)
>
> This ‘package derivation cache’ seems an interesting idea to pursue,
> though I wonder what could be used as ‘keys’ in the derivation cache.
The existing package (used by ‘find-packages-by-name’ & co.) already has
keys: the module and variable name of a top-level package definition.
More precisely, there’d be two keys: (1) a hash of the channel instance
commits being used (as you wrote), and (2) the module/variable name.
That means we’d only keep packages with a public top-level definition in
the cache.
Rough design sketch:
The idea I have in mind would be to have <package> be a sub-record-type
of <proto-package>, where <proto-package> would contain only the
metadata currently provided by ‘fold-available-packages’ (mainly: name,
version, module/variable).
<proto-package> would have a gexp compiler that looks up the
package/derivation mapping in ~/.cache/guix and either return it
directly (cache hit) or look up the corresponding <package>, do all the
work, and add an entry in the cache (cache miss).
Challenges include: arranging so (guix records) can deal with record
type inheritance, deciding what to do with grafts, and probably more.
>> Ludovic Courtès <ludo@gnu.org> skribis:
>>
>> > > +;; repeated 'stat' calls. Allow computing the hash of the file in advance,
>> > > +;; to avoid having to send the file to the daemon when it is already interned
>> > > +;; in the store.
>> > > (define-record-type <local-file>
>> > > - (%%local-file file absolute name recursive? select?)
>> > > + (%%local-file file absolute name sha256 recursive? select?)
>> > > local-file?
>> > > (file local-file-file) ;string
>> > > (absolute %local-file-absolute-file-name) ;promise string
>> > > (name local-file-name) ;string
>> > > + (sha256 local-file-sha256) ;sha256 bytevector | #f
>> >
>> > Could we store the result of ‘fixed-output-path’ rather than the SHA256,
>> > while we’re at it?
>
> Embedding the result of ‘fixed-output-path’ in the .go might be problematic
> from a closure size perspective, as that would create additional references in the
> store items of guix.
Yes, I wonder, not sure about that.
> As it is only <1%, I would prefer trying the ‘package derivation cache’
> first, as it seems to have more potential.
Alright.
Thanks,
Ludo’.
^ permalink raw reply [flat|nested] 16+ messages in thread
* [bug#50384] [PATCH] Optimise search-patch (reducing I/O)
2021-09-27 16:17 ` Ludovic Courtès
@ 2021-10-04 16:46 ` zimoun
2021-10-08 7:41 ` Ludovic Courtès
0 siblings, 1 reply; 16+ messages in thread
From: zimoun @ 2021-10-04 16:46 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: Maxime Devos, 50384
Hi,
On Mon, 27 Sep 2021 at 18:17, Ludovic Courtès <ludo@gnu.org> wrote:
> Rough design sketch:
>
> The idea I have in mind would be to have <package> be a sub-record-type
> of <proto-package>, where <proto-package> would contain only the
> metadata currently provided by ‘fold-available-packages’ (mainly: name,
> version, module/variable).
>
> <proto-package> would have a gexp compiler that looks up the
> package/derivation mapping in ~/.cache/guix and either return it
> directly (cache hit) or look up the corresponding <package>, do all the
> work, and add an entry in the cache (cache miss).
In this rough design sketch, would this <proto-package> help for
improving the situation of "guix search"? Well, could this cache help
at more place than search-patch?
Cheers,
simon
^ permalink raw reply [flat|nested] 16+ messages in thread
* [bug#50384] [PATCH] Optimise search-patch (reducing I/O)
2021-10-04 16:46 ` [bug#50384] [PATCH] " zimoun
@ 2021-10-08 7:41 ` Ludovic Courtès
2021-10-11 8:09 ` [bug#39258] bug#50384: " zimoun
0 siblings, 1 reply; 16+ messages in thread
From: Ludovic Courtès @ 2021-10-08 7:41 UTC (permalink / raw)
To: zimoun; +Cc: Maxime Devos, 50384
Hi zimoun,
zimoun <zimon.toutoune@gmail.com> skribis:
> On Mon, 27 Sep 2021 at 18:17, Ludovic Courtès <ludo@gnu.org> wrote:
>
>> Rough design sketch:
>>
>> The idea I have in mind would be to have <package> be a sub-record-type
>> of <proto-package>, where <proto-package> would contain only the
>> metadata currently provided by ‘fold-available-packages’ (mainly: name,
>> version, module/variable).
>>
>> <proto-package> would have a gexp compiler that looks up the
>> package/derivation mapping in ~/.cache/guix and either return it
>> directly (cache hit) or look up the corresponding <package>, do all the
>> work, and add an entry in the cache (cache miss).
>
> In this rough design sketch, would this <proto-package> help for
> improving the situation of "guix search"? Well, could this cache help
> at more place than search-patch?
Yes, that’s what I thought: <proto-package> could be used in
‘fold-available-packages’ & co., so that would kind of unify that.
Ludo’.
^ permalink raw reply [flat|nested] 16+ messages in thread
* [bug#39258] bug#50384: [PATCH] Optimise search-patch (reducing I/O)
2021-10-08 7:41 ` Ludovic Courtès
@ 2021-10-11 8:09 ` zimoun
0 siblings, 0 replies; 16+ messages in thread
From: zimoun @ 2021-10-11 8:09 UTC (permalink / raw)
To: Ludovic Courtès, 39258; +Cc: Maxime Devos, 50384
Hi Ludo,
On Fri, 8 Oct 2021 at 09:41, Ludovic Courtès <ludo@gnu.org> wrote:
> Yes, that’s what I thought: <proto-package> could be used in
> ‘fold-available-packages’ & co., so that would kind of unify that.
Therefore, do we agree that the cache /lib/guix/package.cache should
be extended? Because the v3 adding an extra cache [1] shows
improvements of "guix search" and v4 moving the extra fields to the
regular cache [2] shows the same improvements for searching and in
addition improves this cache generation. The issue with v4 is the
field 'license'. And v6 is an attempt to by-pass that (keep the
regular cache and only read on-the-fly the required information); but
because of this, I guess:
(module-ref (resolve-interface module) symbol)
it is slower!
1: <http://issues.guix.gnu.org/39258#68>
2: <http://issues.guix.gnu.org/39258#89>
3: <http://issues.guix.gnu.org/39258#119>
All the bests,
simon
PS: For cross-reference, discussion originally happened on
<https://issues.guix.gnu.org/50384>.
^ permalink raw reply [flat|nested] 16+ messages in thread
end of thread, other threads:[~2021-10-11 8:10 UTC | newest]
Thread overview: 16+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2021-09-04 21:17 [bug#50384] [PATCH] Optimise search-patch (reducing I/O) Maxime Devos
2021-09-04 21:47 ` Ludovic Courtès
2021-09-04 22:04 ` Ludovic Courtès
2021-09-05 19:48 ` [bug#50384] [PATCH v2] " Maxime Devos
2021-09-05 22:40 ` Maxime Devos
2021-09-06 8:39 ` zimoun
2021-09-06 10:06 ` Maxime Devos
2021-09-09 14:51 ` [bug#50384] [PATCH] " Ludovic Courtès
2021-09-21 16:55 ` [bug#50384] [PATCH v4] " Ludovic Courtès
2021-09-23 17:26 ` Maxime Devos
2021-09-27 16:17 ` Ludovic Courtès
2021-10-04 16:46 ` [bug#50384] [PATCH] " zimoun
2021-10-08 7:41 ` Ludovic Courtès
2021-10-11 8:09 ` [bug#39258] bug#50384: " zimoun
2021-09-09 20:25 ` [bug#50384] [PATCH v3] " Maxime Devos
2021-09-10 9:54 ` bug#50384: " Maxime Devos
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).