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.
 ;;