derivations: Introduce 'graft' record type.

* guix/derivations.scm (<graft>): New record type.
  (graft-derivation): Rename 'replacements' to 'grafts', and expect it
  to be a list of <graft> records.  Adjust accordingly.
* tests/derivations.scm ("graft-derivation"): Use 'graft' instead of
  pairs in argument to 'graft-derivation'.

.dir-locals.el

@@ -25,6 +25,7 @@
    (eval . (put 'origin 'scheme-indent-function 0))
    (eval . (put 'build-system 'scheme-indent-function 0))
    (eval . (put 'bag 'scheme-indent-function 0))
+   (eval . (put 'graft 'scheme-indent-function 0))
    (eval . (put 'operating-system 'scheme-indent-function 0))
    (eval . (put 'file-system 'scheme-indent-function 0))
    (eval . (put 'manifest-entry 'scheme-indent-function 0))

guix/derivations.scm

@@ -30,6 +30,7 @@ (define-module (guix derivations)
   #:use-module (guix utils)
   #:use-module (guix hash)
   #:use-module (guix base32)
+  #:use-module (guix records)
   #:export (<derivation>
             derivation?
             derivation-outputs
@@ -65,7 +66,15 @@ (define-module (guix derivations)
             derivation-path->output-path
             derivation-path->output-paths
             derivation
+
+            graft
+            graft?
+            graft-origin
+            graft-replacement
+            graft-origin-output
+            graft-replacement-output
             graft-derivation
+
             map-derivation
 
             %guile-for-build
@@ -965,23 +974,31 @@ (define builder
                                   #:guile-for-build guile
                                   #:local-build? #t)))
 
-(define* (graft-derivation store name drv replacements
+(define-record-type* <graft> graft make-graft
+  graft?
+  (origin             graft-origin)               ;derivation | store item
+  (origin-output      graft-origin-output         ;string | #f
+                      (default "out"))
+  (replacement        graft-replacement)          ;derivation | store item
+  (replacement-output graft-replacement-output    ;string | #f
+                      (default "out")))
+
+(define* (graft-derivation store name drv grafts
                            #:key (guile (%guile-for-build)))
-  "Return a derivation called NAME, based on DRV but with all the first
-elements of REPLACEMENTS replaced by the corresponding second element.
-REPLACEMENTS must be a list of ((DRV OUTPUT) . (DRV2 OUTPUT)) pairs."
+  "Return a derivation called NAME, based on DRV but with all the GRAFTS
+applied."
   ;; XXX: Someday rewrite using gexps.
   (define mapping
     ;; List of store item pairs.
     (map (match-lambda
-          (((source source-outputs ...) . (target target-outputs ...))
+          (($ <graft> source source-output target target-output)
            (cons (if (derivation? source)
-                     (apply derivation->output-path source source-outputs)
+                     (derivation->output-path source source-output)
                      source)
                  (if (derivation? target)
-                     (apply derivation->output-path target target-outputs)
+                     (derivation->output-path target target-output)
                      target))))
-         replacements))
+         grafts))
 
   (define outputs
     (match (derivation-outputs drv)
@@ -1013,8 +1030,10 @@ (define build
   (define add-label
     (cut cons "x" <>))
 
-  (match replacements
-    (((sources . targets) ...)
+  (match grafts
+    ((($ <graft> sources source-outputs targets target-outputs) ...)
+     (let ((sources (zip sources source-outputs))
+           (targets (zip targets target-outputs)))
        (build-expression->derivation store name build
                                      #:guile-for-build guile
                                      #:modules '((guix build graft)
@@ -1023,7 +1042,7 @@ (define add-label
                                                 ,@(append (map add-label sources)
                                                           (map add-label targets)))
                                      #:outputs output-names
-                                   #:local-build? #t))))
+                                     #:local-build? #t)))))
 
 (define* (build-expression->derivation store name exp
                                        #:key

tests/derivations.scm

@@ -831,8 +831,12 @@ (define (deps path . deps)
                                                  (lambda (port)
                                                    (display "fake mkdir" port)))))
          (graft (graft-derivation %store "graft" orig
-                                  `(((,%bash) . (,one))
-                                    ((,%mkdir) . (,two))))))
+                                  (list (graft
+                                          (origin %bash)
+                                          (replacement one))
+                                        (graft
+                                          (origin %mkdir)
+                                          (replacement two))))))
     (and (build-derivations %store (list graft))
          (let ((two   (derivation->output-path two))
                (graft (derivation->output-path graft)))