[PATCH 0/4] Rewrite grafts using gexps

  • Done
  • quality assurance status badge
Details
2 participants
  • Liliana Marie Prikler
  • Ludovic Courtès
Owner
unassigned
Submitted by
Ludovic Courtès
Severity
normal
L
L
Ludovic Courtès wrote on 17 Oct 2022 08:47
(address . guix-patches@gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20221017064750.2332-1-ludo@gnu.org
Hello Guix!

This patch series rewrites the guts of (guix grafts) using gexps (it
was our last user of ‘build-expression->derivation’).

Incidentally, it fixes https://issues.guix.gnu.org/58419.

Feedback welcome!

Ludo’.

Ludovic Courtès (4):
grafts: Move '%graft?' and related bindings to (guix store).
Remove now unnecessary uses of (guix grafts).
grafts: Rewrite using gexps.
build-system/gnu: Disable grafts in 'python-build'.

gnu/ci.scm | 3 +-
guix/build-system/python.scm | 3 +-
guix/gexp.scm | 1 -
guix/grafts.scm | 144 +++++++++++++----------------------
guix/lint.scm | 1 -
guix/scripts.scm | 1 -
guix/scripts/archive.scm | 1 -
guix/scripts/build.scm | 3 -
guix/scripts/challenge.scm | 1 -
guix/scripts/deploy.scm | 1 -
guix/scripts/environment.scm | 1 -
guix/scripts/home.scm | 1 -
guix/scripts/pack.scm | 1 -
guix/scripts/package.scm | 1 -
guix/scripts/pull.scm | 1 -
guix/scripts/size.scm | 1 -
guix/scripts/system.scm | 1 -
guix/scripts/weather.scm | 1 -
guix/store.scm | 36 +++++++++
tests/builders.scm | 1 -
tests/channels.scm | 1 -
tests/cpan.scm | 2 +-
tests/derivations.scm | 1 -
tests/gexp.scm | 1 -
tests/graph.scm | 1 -
tests/guix-daemon.sh | 4 +-
tests/monads.scm | 1 -
tests/pack.scm | 1 -
tests/packages.scm | 1 -
tests/profiles.scm | 1 -
tests/system.scm | 1 -
31 files changed, 93 insertions(+), 126 deletions(-)


base-commit: 4dfaddfc44d3a05db7ad9720b8d8942aec3a1d7f
prerequisite-patch-id: 7016063f1ce703056f764119e0c3c27692487caf
--
2.38.0
L
L
Ludovic Courtès wrote on 17 Oct 2022 08:49
[PATCH 1/4] grafts: Move '%graft?' and related bindings to (guix store).
(address . 58579@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20221017064924.2379-1-ludo@gnu.org
The goal is to allow (guix grafts) to use (guix gexp) without
introducing a cycle between these two modules.

* guix/grafts.scm (%graft?, call-without-grafting, without-grafting)
(set-grafting, grafting?): Move to...
* guix/store.scm: ... here.
---
guix/grafts.scm | 41 +++++------------------------------------
guix/store.scm | 36 ++++++++++++++++++++++++++++++++++++
2 files changed, 41 insertions(+), 36 deletions(-)

Toggle diff (115 lines)
diff --git a/guix/grafts.scm b/guix/grafts.scm
index 0ffda8f9aa..252abfd8b3 100644
--- a/guix/grafts.scm
+++ b/guix/grafts.scm
@@ -39,12 +39,11 @@ (define-module (guix grafts)
graft-replacement-output
graft-derivation
- graft-derivation/shallow
-
- %graft?
- without-grafting
- set-grafting
- grafting?))
+ graft-derivation/shallow)
+ #:re-export (%graft? ;for backward compatibility
+ without-grafting
+ set-grafting
+ grafting?))
(define-record-type* <graft> graft make-graft
graft?
@@ -334,36 +333,6 @@ (define* (graft-derivation store drv grafts
(graft-replacement first)
drv)))))
-
-;; The following might feel more at home in (guix packages) but since (guix
-;; gexp), which is a lower level, needs them, we put them here.
-
-(define %graft?
- ;; Whether to honor package grafts by default.
- (make-parameter #t))
-
-(define (call-without-grafting thunk)
- (lambda (store)
- (values (parameterize ((%graft? #f))
- (run-with-store store (thunk)))
- store)))
-
-(define-syntax-rule (without-grafting mexp ...)
- "Bind monadic expressions MEXP in a dynamic extent where '%graft?' is
-false."
- (call-without-grafting (lambda () (mbegin %store-monad mexp ...))))
-
-(define-inlinable (set-grafting enable?)
- ;; This monadic procedure enables grafting when ENABLE? is true, and
- ;; disables it otherwise. It returns the previous setting.
- (lambda (store)
- (values (%graft? enable?) store)))
-
-(define-inlinable (grafting?)
- ;; Return a Boolean indicating whether grafting is enabled.
- (lambda (store)
- (values (%graft?) store)))
-
;; Local Variables:
;; eval: (put 'with-cache 'scheme-indent-function 1)
;; End:
diff --git a/guix/store.scm b/guix/store.scm
index 4d21c5ff1a..a36dce416e 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -182,6 +182,11 @@ (define-module (guix store)
interned-file
interned-file-tree
+ %graft?
+ without-grafting
+ set-grafting
+ grafting?
+
%store-prefix
store-path
output-path
@@ -2171,6 +2176,37 @@ (define* (run-with-store store mval
(set-store-connection-caches! store caches)))
result))))
+
+;;;
+;;; Whether to enable grafts.
+;;;
+
+(define %graft?
+ ;; Whether to honor package grafts by default.
+ (make-parameter #t))
+
+(define (call-without-grafting thunk)
+ (lambda (store)
+ (values (parameterize ((%graft? #f))
+ (run-with-store store (thunk)))
+ store)))
+
+(define-syntax-rule (without-grafting mexp ...)
+ "Bind monadic expressions MEXP in a dynamic extent where '%graft?' is
+false."
+ (call-without-grafting (lambda () (mbegin %store-monad mexp ...))))
+
+(define-inlinable (set-grafting enable?)
+ ;; This monadic procedure enables grafting when ENABLE? is true, and
+ ;; disables it otherwise. It returns the previous setting.
+ (lambda (store)
+ (values (%graft? enable?) store)))
+
+(define-inlinable (grafting?)
+ ;; Return a Boolean indicating whether grafting is enabled.
+ (lambda (store)
+ (values (%graft?) store)))
+
;;;
;;; Store paths.
--
2.38.0
L
L
Ludovic Courtès wrote on 17 Oct 2022 08:49
[PATCH 2/4] Remove now unnecessary uses of (guix grafts).
(address . 58579@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20221017064924.2379-2-ludo@gnu.org
These modules would use (guix grafts) just to access '%graft?' and
related bindings, which are now in (guix store).

* gnu/ci.scm,
guix/gexp.scm,
guix/lint.scm,
guix/scripts.scm,
guix/scripts/archive.scm,
guix/scripts/build.scm,
guix/scripts/challenge.scm,
guix/scripts/deploy.scm,
guix/scripts/environment.scm,
guix/scripts/home.scm,
guix/scripts/pack.scm,
guix/scripts/package.scm,
guix/scripts/pull.scm,
guix/scripts/size.scm,
guix/scripts/system.scm,
guix/scripts/weather.scm,
tests/builders.scm,
tests/channels.scm,
tests/cpan.scm,
tests/derivations.scm,
tests/gexp.scm,
tests/graph.scm,
tests/guix-daemon.sh,
tests/monads.scm,
tests/pack.scm,
tests/packages.scm,
tests/profiles.scm,
tests/system.scm: Remove #:use-module (guix grafts).
---
gnu/ci.scm | 3 +--
guix/gexp.scm | 1 -
guix/lint.scm | 1 -
guix/scripts.scm | 1 -
guix/scripts/archive.scm | 1 -
guix/scripts/build.scm | 3 ---
guix/scripts/challenge.scm | 1 -
guix/scripts/deploy.scm | 1 -
guix/scripts/environment.scm | 1 -
guix/scripts/home.scm | 1 -
guix/scripts/pack.scm | 1 -
guix/scripts/package.scm | 1 -
guix/scripts/pull.scm | 1 -
guix/scripts/size.scm | 1 -
guix/scripts/system.scm | 1 -
guix/scripts/weather.scm | 1 -
tests/builders.scm | 1 -
tests/channels.scm | 1 -
tests/cpan.scm | 2 +-
tests/derivations.scm | 1 -
tests/gexp.scm | 1 -
tests/graph.scm | 1 -
tests/guix-daemon.sh | 4 ++--
tests/monads.scm | 1 -
tests/pack.scm | 1 -
tests/packages.scm | 1 -
tests/profiles.scm | 1 -
tests/system.scm | 1 -
28 files changed, 4 insertions(+), 32 deletions(-)

Toggle diff (359 lines)
diff --git a/gnu/ci.scm b/gnu/ci.scm
index e1ba0f6100..5159205325 100644
--- a/gnu/ci.scm
+++ b/gnu/ci.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012-2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2018, 2019 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
@@ -25,7 +25,6 @@ (define-module (gnu ci)
#:use-module (guix config)
#:autoload (guix describe) (package-channels)
#:use-module (guix store)
- #:use-module (guix grafts)
#:use-module (guix profiles)
#:use-module (guix packages)
#:autoload (guix transformations) (tunable-package? tuned-package)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 73595a216b..5f92174a2c 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -25,7 +25,6 @@ (define-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix derivations)
- #:use-module (guix grafts)
#:use-module (guix utils)
#:use-module (guix diagnostics)
#:use-module (guix i18n)
diff --git a/guix/lint.scm b/guix/lint.scm
index 7ee3a3122f..a6890fa279 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -46,7 +46,6 @@ (define-module (guix lint)
gexp->approximate-sexp))
#:use-module (guix licenses)
#:use-module (guix records)
- #:use-module (guix grafts)
#:use-module (guix upstream)
#:use-module (guix utils)
#:use-module (guix memoization)
diff --git a/guix/scripts.scm b/guix/scripts.scm
index 3aabaf5c9c..4de8bc23b3 100644
--- a/guix/scripts.scm
+++ b/guix/scripts.scm
@@ -22,7 +22,6 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix scripts)
- #:use-module (guix grafts)
#:use-module (guix utils)
#:use-module (guix ui)
#:use-module (guix store)
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index 1e961c84e6..3b2bdee835 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -26,7 +26,6 @@ (define-module (guix scripts archive)
#:select (fold-archive restore-file))
#:use-module (guix store)
#:use-module ((guix status) #:select (with-status-verbosity))
- #:use-module (guix grafts)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix monads)
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 0787dfcc9a..b4437172d7 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -28,10 +28,7 @@ (define-module (guix scripts build)
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (guix memoization)
- #:use-module (guix grafts)
-
#:use-module (guix utils)
-
#:use-module (guix monads)
#:use-module (guix gexp)
#:use-module (guix profiles)
diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm
index f1e5f67dab..620a1762a1 100644
--- a/guix/scripts/challenge.scm
+++ b/guix/scripts/challenge.scm
@@ -22,7 +22,6 @@ (define-module (guix scripts challenge)
#:use-module (guix scripts)
#:use-module (guix store)
#:use-module (guix utils)
- #:use-module (guix grafts)
#:use-module (guix monads)
#:use-module (guix base32)
#:use-module (guix packages)
diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm
index 40a9374171..ef6f9acc86 100644
--- a/guix/scripts/deploy.scm
+++ b/guix/scripts/deploy.scm
@@ -27,7 +27,6 @@ (define-module (guix scripts deploy)
#:use-module (guix gexp)
#:use-module (guix ui)
#:use-module (guix utils)
- #:use-module (guix grafts)
#:use-module ((guix status) #:select (with-status-verbosity))
#:use-module (guix diagnostics)
#:use-module (guix i18n)
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index afe255fa4a..21a12ed532 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -24,7 +24,6 @@ (define-module (guix scripts environment)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module ((guix status) #:select (with-status-verbosity))
- #:use-module (guix grafts)
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (guix profiles)
diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
index 4add7e7c69..0afa6e8174 100644
--- a/guix/scripts/home.scm
+++ b/guix/scripts/home.scm
@@ -47,7 +47,6 @@ (define-module (guix scripts home)
#:use-module (guix derivations)
#:use-module (guix ui)
#:autoload (guix colors) (supports-hyperlinks? file-hyperlink)
- #:use-module (guix grafts)
#:use-module (guix packages)
#:use-module (guix profiles)
#:use-module (guix store)
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 78b6978c92..06849e4761 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -33,7 +33,6 @@ (define-module (guix scripts pack)
#:use-module (guix store)
#:use-module ((guix status) #:select (with-status-verbosity))
#:use-module ((guix self) #:select (make-config.scm))
- #:use-module (guix grafts)
#:autoload (guix inferior) (inferior-package?
inferior-package-name
inferior-package-version)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 7ba2661bbb..b9090307ac 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -33,7 +33,6 @@ (define-module (guix scripts package)
#:use-module ((guix status) #:select (with-status-verbosity))
#:use-module ((guix build syscalls) #:select (terminal-rows))
#:use-module (guix store)
- #:use-module (guix grafts)
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (guix profiles)
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 19224cf70b..7b6c58dbc3 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -31,7 +31,6 @@ (define-module (guix scripts pull)
#:use-module (guix derivations)
#:use-module (guix profiles)
#:use-module (guix gexp)
- #:use-module (guix grafts)
#:use-module (guix memoization)
#:use-module (guix monads)
#:use-module (guix channels)
diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm
index 5bb970443c..48b8ecc881 100644
--- a/guix/scripts/size.scm
+++ b/guix/scripts/size.scm
@@ -24,7 +24,6 @@ (define-module (guix scripts size)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix combinators)
- #:use-module (guix grafts)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (gnu packages)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 560f56408c..aea0acae8d 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -38,7 +38,6 @@ (define-module (guix scripts system)
(sqlite-register store-database-file call-with-database)
#:autoload (guix build store-copy) (copy-store-item)
#:use-module (guix describe)
- #:use-module (guix grafts)
#:use-module (guix gexp)
#:use-module (guix derivations)
#:use-module (guix diagnostics)
diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm
index f46c11b1a5..dc27f81984 100644
--- a/guix/scripts/weather.scm
+++ b/guix/scripts/weather.scm
@@ -29,7 +29,6 @@ (define-module (guix scripts weather)
#:use-module (guix progress)
#:use-module (guix monads)
#:use-module (guix store)
- #:use-module (guix grafts)
#:use-module (guix gexp)
#:use-module (guix colors)
#:use-module ((guix build syscalls) #:select (terminal-columns))
diff --git a/tests/builders.scm b/tests/builders.scm
index 2853227465..0b5577c7a3 100644
--- a/tests/builders.scm
+++ b/tests/builders.scm
@@ -25,7 +25,6 @@ (define-module (tests builders)
#:use-module (guix build gnu-build-system)
#:use-module (guix build utils)
#:use-module (guix build-system python)
- #:use-module (guix grafts)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix utils)
diff --git a/tests/channels.scm b/tests/channels.scm
index 0fe870dbaf..62312e240c 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -23,7 +23,6 @@ (define-module (test-channels)
#:use-module ((guix build syscalls) #:select (mkdtemp!))
#:use-module (guix tests)
#:use-module (guix store)
- #:use-module ((guix grafts) #:select (%graft?))
#:use-module (guix derivations)
#:use-module (guix sets)
#:use-module (guix gexp)
diff --git a/tests/cpan.scm b/tests/cpan.scm
index b4db9e60e4..bbcd108e12 100644
--- a/tests/cpan.scm
+++ b/tests/cpan.scm
@@ -23,7 +23,7 @@ (define-module (test-cpan)
#:use-module (guix base32)
#:use-module (gcrypt hash)
#:use-module (guix tests http)
- #:use-module (guix grafts)
+ #:use-module ((guix store) #:select (%graft?))
#:use-module (srfi srfi-64)
#:use-module (web client)
#:use-module (ice-9 match))
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 57d80412dc..3912fd31d8 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -20,7 +20,6 @@
(define-module (test-derivations)
#:use-module (guix derivations)
- #:use-module (guix grafts)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module ((gcrypt hash) #:prefix gcrypt:)
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 07e940ffdc..6d57ac5d7a 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -21,7 +21,6 @@ (define-module (test-gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix gexp)
- #:use-module (guix grafts)
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (guix build-system trivial)
diff --git a/tests/graph.scm b/tests/graph.scm
index 6aa2d0e0ff..6674b5cc8f 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -24,7 +24,6 @@ (define-module (test-graph)
#:use-module (guix derivations)
#:use-module (guix store)
#:use-module (guix monads)
- #:use-module (guix grafts)
#:use-module (guix build-system gnu)
#:use-module (guix build-system trivial)
#:use-module (guix gexp)
diff --git a/tests/guix-daemon.sh b/tests/guix-daemon.sh
index 330ad68835..4b09c8c162 100644
--- a/tests/guix-daemon.sh
+++ b/tests/guix-daemon.sh
@@ -27,7 +27,7 @@ guix build --version
drv="`guix build emacs -d`"
out="`guile -c ' \
- (use-modules (guix) (guix grafts) (gnu packages emacs)) \
+ (use-modules (guix) (gnu packages emacs)) \
(define store (open-connection)) \
(%graft? #f)
(display (derivation->output-path (package-derivation store emacs)))'`"
@@ -122,7 +122,7 @@ guix-daemon --no-substitutes --listen="$socket" --disable-chroot \
daemon_pid=$!
guile -c "
- (use-modules (guix) (guix grafts) (guix tests) (srfi srfi-34))
+ (use-modules (guix) (guix tests) (srfi srfi-34))
(define store (open-connection-for-tests \"$socket\"))
;; Disable grafts to avoid building more than needed.
diff --git a/tests/monads.scm b/tests/monads.scm
index 19b74f4fb9..7f255f02bf 100644
--- a/tests/monads.scm
+++ b/tests/monads.scm
@@ -20,7 +20,6 @@ (define-module (test-monads)
#:use-module (guix tests)
#:use-module (guix store)
#:use-module (guix monads)
- #:use-module (guix grafts)
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (gnu packages)
diff --git a/tests/pack.scm b/tests/pack.scm
index 98bfedf21c..a4c388d93e 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -25,7 +25,6 @@ (define-module (test-pack)
#:use-module (guix profiles)
#:use-module (guix packages)
#:use-module (guix monads)
- #:use-module (guix grafts)
#:use-module (guix tests)
#:use-module (guix gexp)
#:use-module (guix modules)
diff --git a/tests/packages.scm b/tests/packages.scm
index dc03b13417..a71eb1125d 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -23,7 +23,6 @@ (define-module (tests packages)
#:use-module (guix tests)
#:use-module (guix store)
#:use-module (guix monads)
- #:use-module (guix grafts)
#:use-module (guix gexp)
#:use-module (guix utils)
#:use-module ((guix build utils) #:select (tarball?))
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 7bed946bf3..9ad03f2b24 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -23,7 +23,6 @@ (define-module (test-profiles)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
- #:use-module (guix grafts)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix build-system trivial)
diff --git a/tests/system.scm b/tests/system.scm
index 873fed4aee..876e15a25e 100644
--- a/tests/system.scm
+++ b/tests/system.scm
@@ -24,7 +24,6 @@ (define-module (test-system)
#:use-module (guix monads)
#:use-module ((guix gexp) #:select (lower-object))
#:use-module ((guix utils) #:select (%current-system))
- #:use-module (guix grafts)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-64))
--
2.38.0
L
L
Ludovic Courtès wrote on 17 Oct 2022 08:49
[PATCH 4/4] build-system/gnu: Disable grafts in 'python-build'.
(address . 58579@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20221017064924.2379-4-ludo@gnu.org
This is consistent with what 'gnu-build' does and makes sure origins
aren't getting lowered with #:graft? #t in one case and not in the
other.

* guix/build-system/python.scm (python-build): Pass #:graft? #f.
---
guix/build-system/python.scm | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)

Toggle diff (21 lines)
diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm
index efade6f74b..c8f04b2298 100644
--- a/guix/build-system/python.scm
+++ b/guix/build-system/python.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2017, 2021-2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2021 Lars-Dominik Braun <lars@6xq.net>
@@ -212,6 +212,7 @@ (define build
system #:graft? #f)))
(gexp->derivation name build
#:system system
+ #:graft? #f ;consistent with 'gnu-build'
#:target #f
#:guile-for-build guile)))
--
2.38.0
L
L
Ludovic Courtès wrote on 17 Oct 2022 08:49
[PATCH 3/4] grafts: Rewrite using gexps.
(address . 58579@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20221017064924.2379-3-ludo@gnu.org

* guix/grafts.scm (graft-derivation/shallow): Rewrite using gexps and
remove 'store' parameter.
(graft-derivation/shallow*): New variable.
(cumulative-grafts): Use it instead of 'graft-derivation/shallow'.
---
guix/grafts.scm | 103 +++++++++++++++++++++---------------------------
1 file changed, 46 insertions(+), 57 deletions(-)

Toggle diff (151 lines)
diff --git a/guix/grafts.scm b/guix/grafts.scm
index 252abfd8b3..88406e1087 100644
--- a/guix/grafts.scm
+++ b/guix/grafts.scm
@@ -24,6 +24,7 @@ (define-module (guix grafts)
#:use-module (guix derivations)
#:use-module ((guix utils) #:select (%current-system))
#:use-module (guix sets)
+ #:use-module (guix gexp)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-26)
@@ -78,7 +79,7 @@ (define (graft-origin-file-name graft)
(($ <graft> (? string? item))
item)))
-(define* (graft-derivation/shallow store drv grafts
+(define* (graft-derivation/shallow drv grafts
#:key
(name (derivation-name drv))
(outputs (derivation-output-names drv))
@@ -87,72 +88,60 @@ (define* (graft-derivation/shallow store drv grafts
"Return a derivation called NAME, which applies GRAFTS to the specified
OUTPUTS of DRV. This procedure performs \"shallow\" grafting in that GRAFTS
are not recursively applied to dependencies of DRV."
- ;; XXX: Someday rewrite using gexps.
(define mapping
;; List of store item pairs.
- (map (match-lambda
- (($ <graft> source source-output target target-output)
- (cons (if (derivation? source)
- (derivation->output-path source source-output)
- source)
- (if (derivation? target)
- (derivation->output-path target target-output)
- target))))
+ (map (lambda (graft)
+ (gexp
+ ((ungexp (graft-origin graft)
+ (graft-origin-output graft))
+ . (ungexp (graft-replacement graft)
+ (graft-replacement-output graft)))))
grafts))
- (define output-pairs
- (map (lambda (output)
- (cons output
- (derivation-output-path
- (assoc-ref (derivation-outputs drv) output))))
- outputs))
-
(define build
- `(begin
- (use-modules (guix build graft)
- (guix build utils)
- (ice-9 match))
+ (with-imported-modules '((guix build graft)
+ (guix build utils)
+ (guix build debug-link)
+ (guix elf))
+ #~(begin
+ (use-modules (guix build graft)
+ (guix build utils)
+ (ice-9 match))
- (let* ((old-outputs ',output-pairs)
- (mapping (append ',mapping
- (map (match-lambda
- ((name . file)
- (cons (assoc-ref old-outputs name)
- file)))
- %outputs))))
- (graft old-outputs %outputs mapping))))
+ (define %outputs
+ (ungexp (outputs->gexp outputs)))
+
+ (let* ((old-outputs '(ungexp
+ (map (lambda (output)
+ (gexp ((ungexp output)
+ . (ungexp drv output))))
+ outputs)))
+ (mapping (append '(ungexp mapping)
+ (map (match-lambda
+ ((name . file)
+ (cons (assoc-ref old-outputs name)
+ file)))
+ %outputs))))
+ (graft old-outputs %outputs mapping)))))
- (define add-label
- (cut cons "x" <>))
(define properties
`((type . graft)
(graft (count . ,(length grafts)))))
- (match grafts
- ((($ <graft> sources source-outputs targets target-outputs) ...)
- (let ((sources (zip sources source-outputs))
- (targets (zip targets target-outputs)))
- (build-expression->derivation store name build
- #:system system
- #:guile-for-build guile
- #:modules '((guix build graft)
- (guix build utils)
- (guix build debug-link)
- (guix elf))
- #:inputs `(,@(map (lambda (out)
- `("x" ,drv ,out))
- outputs)
- ,@(append (map add-label sources)
- (map add-label targets)))
- #:outputs outputs
+ (gexp->derivation name build
+ #:system system
+ #:guile-for-build guile
- ;; Grafts are computationally cheap so no
- ;; need to offload or substitute.
- #:local-build? #t
- #:substitutable? #f
+ ;; Grafts are computationally cheap so no
+ ;; need to offload or substitute.
+ #:local-build? #t
+ #:substitutable? #f
- #:properties properties)))))
+ #:properties properties))
+
+(define graft-derivation/shallow*
+ (store-lower graft-derivation/shallow))
(define (non-self-references store drv outputs)
"Return the list of references of the OUTPUTS of DRV, excluding self
@@ -291,10 +280,10 @@ (define (dependency-grafts items)
;; Use APPLICABLE, the subset of GRAFTS that is really
;; applicable to DRV, to avoid creating several identical
;; grafted variants of DRV.
- (let* ((new (graft-derivation/shallow store drv applicable
- #:outputs outputs
- #:guile guile
- #:system system))
+ (let* ((new (graft-derivation/shallow* store drv applicable
+ #:outputs outputs
+ #:guile guile
+ #:system system))
(grafts (append (map (lambda (output)
(graft
(origin drv)
--
2.38.0
L
L
Liliana Marie Prikler wrote on 17 Oct 2022 10:00
Re: [PATCH 4/4] build-system/gnu: Disable grafts in 'python-build'.
6873f61154672b02c8c6da74b00597776d9f019a.camel@ist.tugraz.at
Hi Ludo’,

regarding the name of this patch, shouldn't it be "build-system:
python: Disable grafts." or even "build-system: python: Leave grafts
as-is when lowering."?

Am Montag, dem 17.10.2022 um 08:49 +0200 schrieb Ludovic Courtès:
Toggle quote (5 lines)
> This is consistent with what 'gnu-build' does and makes sure origins
> aren't getting lowered with #:graft? #t in one case and not in the
> other.
>
> * guix/build-system/python.scm (python-build): Pass #:graft? #f.
I think mentioning df46bef48eaa43c502fa9193371692c039b460c1 would be
helpful.


The series otherwise LGTM. I assume you didn't tag it core-updates,
because it doesn't actually cause any rebuilds?

Cheers
L
L
Ludovic Courtès wrote on 17 Oct 2022 18:40
(name . Liliana Marie Prikler)(address . liliana.prikler@ist.tugraz.at)(address . 58579@debbugs.gnu.org)
87r0z6pfny.fsf@gnu.org
Hi,

Liliana Marie Prikler <liliana.prikler@ist.tugraz.at> skribis:

Toggle quote (4 lines)
> regarding the name of this patch, shouldn't it be "build-system:
> python: Disable grafts." or even "build-system: python: Leave grafts
> as-is when lowering."?

It should definitely read “python” and not “gnu”. It is about disabling
grafts at this stage.

Toggle quote (9 lines)
> Am Montag, dem 17.10.2022 um 08:49 +0200 schrieb Ludovic Courtès:
>> This is consistent with what 'gnu-build' does and makes sure origins
>> aren't getting lowered with #:graft? #t in one case and not in the
>> other.
>>
>> * guix/build-system/python.scm (python-build): Pass #:graft? #f.
> I think mentioning df46bef48eaa43c502fa9193371692c039b460c1 would be
> helpful.

Good idea, will do.

Toggle quote (3 lines)
> The series otherwise LGTM. I assume you didn't tag it core-updates,
> because it doesn't actually cause any rebuilds?

Exactly.

Thank you!

Ludo’.
L
L
Ludovic Courtès wrote on 22 Oct 2022 01:51
Re: bug#58579: [PATCH 0/4] Rewrite grafts using gexps
(address . 58579-done@debbugs.gnu.org)(address . 58419-done@debbugs.gnu.org)
87y1t84twm.fsf@gnu.org
Hi,

Ludovic Courtès <ludo@gnu.org> skribis:

Toggle quote (5 lines)
> grafts: Move '%graft?' and related bindings to (guix store).
> Remove now unnecessary uses of (guix grafts).
> grafts: Rewrite using gexps.
> build-system/gnu: Disable grafts in 'python-build'.

I took Liliana’s suggestion into account and pushed as
863c228bfd53aac478eee46f6ee54d87fee9d764.

Thanks,
Ludo’.
Closed
?
Your comment

This issue is archived.

To comment on this conversation send an email to 58579@debbugs.gnu.org

To respond to this issue using the mumi CLI, first switch to it
mumi current 58579
Then, you may apply the latest patchset in this issue (with sign off)
mumi am -- -s
Or, compose a reply to this issue
mumi compose
Or, send patches to this issue
mumi send-email *.patch