* [bug#58579] [PATCH 0/4] Rewrite grafts using gexps
@ 2022-10-17 6:47 Ludovic Courtès
2022-10-17 6:49 ` [bug#58579] [PATCH 1/4] grafts: Move '%graft?' and related bindings to (guix store) Ludovic Courtès
0 siblings, 1 reply; 7+ messages in thread
From: Ludovic Courtès @ 2022-10-17 6:47 UTC (permalink / raw)
To: 58579; +Cc: Ludovic Courtès, 58419
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
^ permalink raw reply [flat|nested] 7+ messages in thread
* [bug#58579] [PATCH 1/4] grafts: Move '%graft?' and related bindings to (guix store).
2022-10-17 6:47 [bug#58579] [PATCH 0/4] Rewrite grafts using gexps Ludovic Courtès
@ 2022-10-17 6:49 ` Ludovic Courtès
2022-10-17 6:49 ` [bug#58579] [PATCH 2/4] Remove now unnecessary uses of (guix grafts) Ludovic Courtès
` (2 more replies)
0 siblings, 3 replies; 7+ messages in thread
From: Ludovic Courtès @ 2022-10-17 6:49 UTC (permalink / raw)
To: 58579; +Cc: Ludovic Courtès
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(-)
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)))))
-\f
-;; 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))))
+\f
+;;;
+;;; 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)))
+
\f
;;;
;;; Store paths.
--
2.38.0
^ permalink raw reply related [flat|nested] 7+ messages in thread
* [bug#58579] [PATCH 2/4] Remove now unnecessary uses of (guix grafts).
2022-10-17 6:49 ` [bug#58579] [PATCH 1/4] grafts: Move '%graft?' and related bindings to (guix store) Ludovic Courtès
@ 2022-10-17 6:49 ` Ludovic Courtès
2022-10-17 6:49 ` [bug#58579] [PATCH 3/4] grafts: Rewrite using gexps Ludovic Courtès
2022-10-17 6:49 ` [bug#58579] [PATCH 4/4] build-system/gnu: Disable grafts in 'python-build' Ludovic Courtès
2 siblings, 0 replies; 7+ messages in thread
From: Ludovic Courtès @ 2022-10-17 6:49 UTC (permalink / raw)
To: 58579; +Cc: Ludovic Courtès
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(-)
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
^ permalink raw reply related [flat|nested] 7+ messages in thread
* [bug#58579] [PATCH 3/4] grafts: Rewrite using gexps.
2022-10-17 6:49 ` [bug#58579] [PATCH 1/4] grafts: Move '%graft?' and related bindings to (guix store) Ludovic Courtès
2022-10-17 6:49 ` [bug#58579] [PATCH 2/4] Remove now unnecessary uses of (guix grafts) Ludovic Courtès
@ 2022-10-17 6:49 ` Ludovic Courtès
2022-10-17 6:49 ` [bug#58579] [PATCH 4/4] build-system/gnu: Disable grafts in 'python-build' Ludovic Courtès
2 siblings, 0 replies; 7+ messages in thread
From: Ludovic Courtès @ 2022-10-17 6:49 UTC (permalink / raw)
To: 58579; +Cc: Ludovic Courtès
Fixes <https://issues.guix.gnu.org/58419>.
* 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(-)
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
^ permalink raw reply related [flat|nested] 7+ messages in thread
* [bug#58579] [PATCH 4/4] build-system/gnu: Disable grafts in 'python-build'.
2022-10-17 6:49 ` [bug#58579] [PATCH 1/4] grafts: Move '%graft?' and related bindings to (guix store) Ludovic Courtès
2022-10-17 6:49 ` [bug#58579] [PATCH 2/4] Remove now unnecessary uses of (guix grafts) Ludovic Courtès
2022-10-17 6:49 ` [bug#58579] [PATCH 3/4] grafts: Rewrite using gexps Ludovic Courtès
@ 2022-10-17 6:49 ` Ludovic Courtès
2022-10-17 8:00 ` Liliana Marie Prikler
2 siblings, 1 reply; 7+ messages in thread
From: Ludovic Courtès @ 2022-10-17 6:49 UTC (permalink / raw)
To: 58579; +Cc: 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.
---
guix/build-system/python.scm | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
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
^ permalink raw reply related [flat|nested] 7+ messages in thread
* [bug#58579] [PATCH 4/4] build-system/gnu: Disable grafts in 'python-build'.
2022-10-17 6:49 ` [bug#58579] [PATCH 4/4] build-system/gnu: Disable grafts in 'python-build' Ludovic Courtès
@ 2022-10-17 8:00 ` Liliana Marie Prikler
2022-10-17 16:40 ` Ludovic Courtès
0 siblings, 1 reply; 7+ messages in thread
From: Liliana Marie Prikler @ 2022-10-17 8:00 UTC (permalink / raw)
To: Ludovic Courtès, 58579
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:
> 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
^ permalink raw reply [flat|nested] 7+ messages in thread
* [bug#58579] [PATCH 4/4] build-system/gnu: Disable grafts in 'python-build'.
2022-10-17 8:00 ` Liliana Marie Prikler
@ 2022-10-17 16:40 ` Ludovic Courtès
0 siblings, 0 replies; 7+ messages in thread
From: Ludovic Courtès @ 2022-10-17 16:40 UTC (permalink / raw)
To: Liliana Marie Prikler; +Cc: 58579
Hi,
Liliana Marie Prikler <liliana.prikler@ist.tugraz.at> skribis:
> 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.
> 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.
> 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’.
^ permalink raw reply [flat|nested] 7+ messages in thread
end of thread, other threads:[~2022-10-17 16:41 UTC | newest]
Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-10-17 6:47 [bug#58579] [PATCH 0/4] Rewrite grafts using gexps Ludovic Courtès
2022-10-17 6:49 ` [bug#58579] [PATCH 1/4] grafts: Move '%graft?' and related bindings to (guix store) Ludovic Courtès
2022-10-17 6:49 ` [bug#58579] [PATCH 2/4] Remove now unnecessary uses of (guix grafts) Ludovic Courtès
2022-10-17 6:49 ` [bug#58579] [PATCH 3/4] grafts: Rewrite using gexps Ludovic Courtès
2022-10-17 6:49 ` [bug#58579] [PATCH 4/4] build-system/gnu: Disable grafts in 'python-build' Ludovic Courtès
2022-10-17 8:00 ` Liliana Marie Prikler
2022-10-17 16:40 ` Ludovic Courtès
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).