[bug#50384] [PATCH v3] Optimise search-patch (reducing I/O)

[Maxime Devos <maximedevos@telenet.be>]

[-- 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 --]