diff options
author | Ludovic Courtès <ludo@gnu.org> | 2020-09-21 17:44:29 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2020-09-27 21:41:05 +0200 |
commit | ff39361c80dfc67a9afe35f315a774140d8cf99b (patch) | |
tree | f0183ad15f06b50121cc0dbfb2c293b93770f8ca /guix | |
parent | f458cfbcc54ed87b1a87dd9e150ea276f17eab74 (diff) | |
download | guix-patches-ff39361c80dfc67a9afe35f315a774140d8cf99b.tar guix-patches-ff39361c80dfc67a9afe35f315a774140d8cf99b.tar.gz |
packages: 'package-mapping' can recurse on implicit inputs.
* guix/packages.scm (build-system-with-package-mapping): New procedure.
(package-mapping): Add #:deep? and honor it.
* tests/packages.scm ("package-mapping"): Compare the direct inputs of
the bag of P0 and that of P1.
("package-mapping, deep"): New test.
Diffstat (limited to 'guix')
-rw-r--r-- | guix/packages.scm | 65 |
1 files changed, 50 insertions, 15 deletions
diff --git a/guix/packages.scm b/guix/packages.scm index 6598bd3149..171fd048ef 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -968,10 +968,31 @@ packages they depend on, recursively." (vhash-consq package #t visited) (fold set-insert closure dependencies)))))))) -(define* (package-mapping proc #:optional (cut? (const #f))) +(define (build-system-with-package-mapping bs rewrite) + "Return a variant of BS, a build system, that rewrites a bag's inputs by +passing them through REWRITE, a procedure that takes an input tuplet and +returns a \"rewritten\" input tuplet." + (define lower + (build-system-lower bs)) + + (define (lower* . args) + (let ((lowered (apply lower args))) + (bag + (inherit lowered) + (build-inputs (map rewrite (bag-build-inputs lowered))) + (host-inputs (map rewrite (bag-host-inputs lowered))) + (target-inputs (map rewrite (bag-target-inputs lowered)))))) + + (build-system + (inherit bs) + (lower lower*))) + +(define* (package-mapping proc #:optional (cut? (const #f)) + #:key deep?) "Return a procedure that, given a package, applies PROC to all the packages depended on and returns the resulting package. The procedure stops recursion -when CUT? returns true for a given package." +when CUT? returns true for a given package. When DEEP? is true, PROC is +applied to implicit inputs as well." (define (rewrite input) (match input ((label (? package? package) outputs ...) @@ -980,21 +1001,35 @@ when CUT? returns true for a given package." (_ input))) + (define mapping-property + ;; Property indicating whether the package has already been processed. + (gensym " package-mapping-done")) + (define replace (mlambdaq (p) - ;; Return a variant of P with PROC applied to P and its explicit - ;; dependencies, recursively. Memoize the transformations. Failing to - ;; do that, we would build a huge object graph with lots of duplicates, - ;; which in turns prevents us from benefiting from memoization in - ;; 'package-derivation'. - (let ((p (proc p))) - (package - (inherit p) - (location (package-location p)) - (inputs (map rewrite (package-inputs p))) - (native-inputs (map rewrite (package-native-inputs p))) - (propagated-inputs (map rewrite (package-propagated-inputs p))) - (replacement (and=> (package-replacement p) proc)))))) + ;; If P is the result of a previous call, return it. + (if (assq-ref (package-properties p) mapping-property) + p + + ;; Return a variant of P with PROC applied to P and its explicit + ;; dependencies, recursively. Memoize the transformations. Failing + ;; to do that, we would build a huge object graph with lots of + ;; duplicates, which in turns prevents us from benefiting from + ;; memoization in 'package-derivation'. + (let ((p (proc p))) + (package + (inherit p) + (location (package-location p)) + (build-system (if deep? + (build-system-with-package-mapping + (package-build-system p) rewrite) + (package-build-system p))) + (inputs (map rewrite (package-inputs p))) + (native-inputs (map rewrite (package-native-inputs p))) + (propagated-inputs (map rewrite (package-propagated-inputs p))) + (replacement (and=> (package-replacement p) proc)) + (properties `((,mapping-property . #t) + ,@(package-properties p)))))))) replace) |