From 8819551c8d2a12cd4e84e09b51e434d05a012c9d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 23 Sep 2020 14:56:38 +0200 Subject: packages: 'package-input-rewriting' has a #:deep? parameter. * guix/packages.scm (package-input-rewriting): Add #:deep? and pass it to 'package-mapping'. [replacement-property]: New variable. [rewrite]: Check it. [cut?]: New procedure. * tests/packages.scm ("package-input-rewriting"): Pass #:deep? #f and ensure implicit inputs were not rewritten. Avoid 'eq?' comparisons. ("package-input-rewriting, deep"): New test. * gnu/packages/guile.scm (package-for-guile-2.0, package-for-guile-3.0): Pass #:deep? #f. --- guix/packages.scm | 35 +++++++++++++++++++++++++---------- 1 file changed, 25 insertions(+), 10 deletions(-) (limited to 'guix/packages.scm') diff --git a/guix/packages.scm b/guix/packages.scm index 0d0d7492b6..4f2bb432be 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -1044,22 +1044,37 @@ applied to implicit inputs as well." replace) (define* (package-input-rewriting replacements - #:optional (rewrite-name identity)) + #:optional (rewrite-name identity) + #:key (deep? #t)) "Return a procedure that, when passed a package, replaces its direct and -indirect dependencies (but not its implicit inputs) according to REPLACEMENTS. -REPLACEMENTS is a list of package pairs; the first element of each pair is the -package to replace, and the second one is the replacement. +indirect dependencies, including implicit inputs when DEEP? is true, according +to REPLACEMENTS. REPLACEMENTS is a list of package pairs; the first element +of each pair is the package to replace, and the second one is the replacement. Optionally, REWRITE-NAME is a one-argument procedure that takes the name of a package and returns its new name after rewrite." + (define replacement-property + ;; Property to tag right-hand sides in REPLACEMENTS. + (gensym " package-replacement")) + (define (rewrite p) - (match (assq-ref replacements p) - (#f (package - (inherit p) - (name (rewrite-name (package-name p))))) - (new new))) + (if (assq-ref (package-properties p) replacement-property) + p + (match (assq-ref replacements p) + (#f (package/inherit p + (name (rewrite-name (package-name p))))) + (new (if deep? + (package/inherit new + (properties `((,replacement-property . #t) + ,@(package-properties new)))) + new))))) - (package-mapping rewrite (cut assq <> replacements))) + (define (cut? p) + (or (assq-ref (package-properties p) replacement-property) + (assq-ref replacements p))) + + (package-mapping rewrite cut? + #:deep? deep?)) (define* (package-input-rewriting/spec replacements #:key (deep? #t)) "Return a procedure that, given a package, applies the given REPLACEMENTS to -- cgit v1.2.3