summaryrefslogtreecommitdiff
path: root/guix/store.scm
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2020-03-30 12:17:33 +0200
committerMarius Bakke <mbakke@fastmail.com>2020-03-30 12:17:33 +0200
commitae0badf5bb791428423a98d4e4e2b8d297a5d4be (patch)
tree4282d243db3e90839a5f7d3b5878674ccd0e2e14 /guix/store.scm
parentee401ed9249fbe284ef1b9b437d39207ca88131b (diff)
parent927f3655662b41f25225ea03baa3ded687aa7cbb (diff)
downloadguix-patches-ae0badf5bb791428423a98d4e4e2b8d297a5d4be.tar
guix-patches-ae0badf5bb791428423a98d4e4e2b8d297a5d4be.tar.gz
Merge branch 'master' into core-updates
Conflicts: gnu/packages/admin.scm gnu/packages/commencement.scm gnu/packages/guile.scm gnu/packages/linux.scm gnu/packages/package-management.scm gnu/packages/pulseaudio.scm gnu/packages/web.scm
Diffstat (limited to 'guix/store.scm')
-rw-r--r--guix/store.scm64
1 files changed, 64 insertions, 0 deletions
diff --git a/guix/store.scm b/guix/store.scm
index 5dea264811..12f66d0e71 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -106,6 +106,8 @@
file-mapping->tree
binary-file
with-build-handler
+ map/accumulate-builds
+ mapm/accumulate-builds
build-things
build
query-failed-paths
@@ -134,6 +136,7 @@
built-in-builders
references
+ references/cached
references/substitutes
references*
query-path-info*
@@ -1303,6 +1306,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))
@@ -1389,6 +1434,13 @@ error if there is no such root."
;; would use a cache associated with the daemon connection instead (XXX).
(make-hash-table 100))
+(define (references/cached store item)
+ "Like 'references', but cache results."
+ (or (hash-ref %reference-cache item)
+ (let ((references (references store item)))
+ (hash-set! %reference-cache item references)
+ references)))
+
(define (references/substitutes store items)
"Return the list of list of references of ITEMS; the result has the same
length as ITEMS. Query substitute information for any item missing from the
@@ -1829,6 +1881,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.
;;