[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/10: store: Add #:cut? parameter to 'topologically-sorted'.
From: |
guix-commits |
Subject: |
03/10: store: Add #:cut? parameter to 'topologically-sorted'. |
Date: |
Sun, 5 Jan 2020 05:51:31 -0500 (EST) |
civodul pushed a commit to branch wip-system-bootstrap
in repository guix.
commit 947c4a16899bc6673e3e04e6f7c50c2c63ad43e5
Author: Ludovic Courtès <address@hidden>
Date: Thu Dec 12 12:55:42 2019 +0100
store: Add #:cut? parameter to 'topologically-sorted'.
* guix/store.scm (topologically-sorted): Add #:cut? and honor it.
* tests/store.scm ("topologically-sorted, one item, cutting"): New
test.
---
guix/store.scm | 30 +++++++++++++++++-------------
tests/store.scm | 10 ++++++++++
2 files changed, 27 insertions(+), 13 deletions(-)
diff --git a/guix/store.scm b/guix/store.scm
index f99fa58..2d4917d 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -1378,9 +1378,10 @@ SEED."
its references, recursively)."
(fold-path store cons '() paths))
-(define (topologically-sorted store paths)
+(define* (topologically-sorted store paths #:key (cut? (const #f)))
"Return a list containing PATHS and all their references sorted in
-topological order."
+topological order. Skip store items that match CUT? as well as their
+dependencies."
(define (traverse)
;; Do a simple depth-first traversal of all of PATHS.
(let loop ((paths paths)
@@ -1394,17 +1395,20 @@ topological order."
(match paths
((head tail ...)
- (if (visited? head)
- (loop tail visited result)
- (call-with-values
- (lambda ()
- (loop (references store head)
- (visit head)
- result))
- (lambda (visited result)
- (loop tail
- visited
- (cons head result))))))
+ (cond ((visited? head)
+ (loop tail visited result))
+ ((cut? head)
+ (loop tail visited result))
+ (else
+ (call-with-values
+ (lambda ()
+ (loop (references store head)
+ (visit head)
+ result))
+ (lambda (visited result)
+ (loop tail
+ visited
+ (cons head result)))))))
(()
(values visited result)))))
diff --git a/tests/store.scm b/tests/store.scm
index 2b14a4a..49729b2 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -388,6 +388,16 @@
(s (topologically-sorted %store (list d))))
(equal? s (list a b c d))))
+(test-assert "topologically-sorted, one item, cutting"
+ (let* ((a (add-text-to-store %store "a" "a"))
+ (b (add-text-to-store %store "b" "b" (list a)))
+ (c (add-text-to-store %store "c" "c" (list b)))
+ (d (add-text-to-store %store "d" "d" (list c)))
+ (s (topologically-sorted %store (list d)
+ #:cut?
+ (cut string-suffix? "-b" <>))))
+ (equal? s (list c d))))
+
(test-assert "topologically-sorted, several items"
(let* ((a (add-text-to-store %store "a" "a"))
(b (add-text-to-store %store "b" "b" (list a)))
- branch wip-system-bootstrap created (now 3bccc5e), guix-commits, 2020/01/05
- 03/10: store: Add #:cut? parameter to 'topologically-sorted'.,
guix-commits <=
- 01/10: utils: 'version-compare' delays 'dynamic-link' code., guix-commits, 2020/01/05
- 04/10: derivations: Add #:skip-dependencies? parameter to 'derivation-input-fold'., guix-commits, 2020/01/05
- 05/10: DRAFT gexp: Add 'raw-derivation-closure'., guix-commits, 2020/01/05
- 02/10: monads: Add portability to Guile 2.0., guix-commits, 2020/01/05
- 06/10: DRAFT gexp: Add 'object-sources'., guix-commits, 2020/01/05
- 09/10: DRAFT serialization: Avoid 'define-values', for the sake of Guile 2.0., guix-commits, 2020/01/05
- 08/10: bootstrap: Add %bootstrap-guile+guild., guix-commits, 2020/01/05
- 10/10: system: bootstrap: Compute and print the result's hash., guix-commits, 2020/01/05
- 07/10: DRAFT system: Add (gnu system bootstrap)., guix-commits, 2020/01/05