[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/06: DRAFT store: Add 'map/accumulate-builds'.
From: |
guix-commits |
Subject: |
01/06: DRAFT store: Add 'map/accumulate-builds'. |
Date: |
Wed, 25 Mar 2020 11:22:57 -0400 (EDT) |
civodul pushed a commit to branch wip-build-accumulator
in repository guix.
commit 066c8ba2c6678f64e838484bed62d641cf2af094
Author: Ludovic Courtès <address@hidden>
AuthorDate: Wed Mar 25 12:41:18 2020 +0100
DRAFT store: Add 'map/accumulate-builds'.
DRAFT: Add tests.
* guix/store.scm (<unresolved>): New record type.
(build-accumulator, map/accumulate-builds, mapm/accumulate-builds): New
procedures.
---
guix/store.scm | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 56 insertions(+)
diff --git a/guix/store.scm b/guix/store.scm
index fdaae27..b3641ef 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -105,6 +105,8 @@
add-file-tree-to-store
binary-file
with-build-handler
+ map/accumulate-builds
+ mapm/accumulate-builds
build-things
build
query-failed-paths
@@ -1263,6 +1265,48 @@ deals with \"dynamic dependencies\" such as
grafts---derivations that depend
on the build output of a previous derivation."
(call-with-build-handler handler (lambda () exp ...)))
+;; Unresolved dynamic dependency.
+(define-record-type <unresolved>
+ (unresolved things continuation)
+ unresolved?
+ (things unresolved-things)
+ (continuation unresolved-continuation))
+
+(define (build-accumulator continue store things mode)
+ "This build handler accumulates THINGS and returns an <unresolved> object."
+ (if (= mode (build-mode normal))
+ (unresolved things continue)
+ (continue #t)))
+
+(define (map/accumulate-builds store proc lst)
+ "Apply PROC over each element of LST, accumulating 'build-things' calls and
+coalescing them into a single call."
+ (define result
+ (map (lambda (obj)
+ (with-build-handler build-accumulator
+ (proc obj)))
+ lst))
+
+ (match (append-map (lambda (obj)
+ (if (unresolved? obj)
+ (unresolved-things obj)
+ '()))
+ result)
+ (()
+ result)
+ (to-build
+ ;; We've accumulated things TO-BUILD. Actually build them and resume the
+ ;; corresponding continuations.
+ (build-things store (delete-duplicates to-build))
+ (map/accumulate-builds store
+ (lambda (obj)
+ (if (unresolved? obj)
+ ;; Pass #f because 'build-things' is now
+ ;; unnecessary.
+ ((unresolved-continuation obj) #f)
+ obj))
+ result))))
+
(define build-things
(let ((build (operation (build-things (string-list things)
(integer mode))
@@ -1789,6 +1833,18 @@ taking the store as its first argument."
(lambda (store . args)
(run-with-store store (apply proc args)))))
+(define (mapm/accumulate-builds mproc lst)
+ "Like 'mapm' in %STORE-MONAD, but accumulate 'build-things' calls and
+coalesce them into a single call."
+ (lambda (store)
+ (values (map/accumulate-builds store
+ (lambda (obj)
+ (run-with-store store
+ (mproc obj)))
+ lst)
+ store)))
+
+
;;
;; Store monad operators.
;;
- branch wip-build-accumulator created (now 5992933), guix-commits, 2020/03/25
- 01/06: DRAFT store: Add 'map/accumulate-builds'.,
guix-commits <=
- 02/06: guix build: Use 'map/accumulate-builds'., guix-commits, 2020/03/25
- 03/06: DRAFT gexp: 'lower-inputs' uses 'mapm/accumulate-builds'., guix-commits, 2020/03/25
- 04/06: profiles: Use 'mapm/accumulate-builds'., guix-commits, 2020/03/25
- 05/06: grafts: Don't rely on substitute info for missing store items., guix-commits, 2020/03/25
- 06/06: '--dry-run' no longer implies '--no-grafts'., guix-commits, 2020/03/25