gexp: <lowered-gexp> separates sources from derivation inputs.

* guix/gexp.scm (lower-inputs): Return either <derivation-input> records
or store items.
(lower-reference-graphs): Return file/input pairs.
(<lowered-gexp>)[sources]: New field.
(lower-gexp): Adjust accordingly.
(gexp->input-tuple): Remove.
(gexp->derivation)[graphs-file-names]: Handle only the
'derivation-input?' and 'string?' cases.
Pass #:sources to 'raw-derivation'; ensure #:inputs contains only
<derivation-input> records.
* guix/remote.scm (remote-eval): Adjust to the new <lowered-gexp>
interface.
* tests/gexp.scm ("lower-gexp"): Adjust to expect <derivation-input>
records instead of <gexp-input>

3 files changed, 60 insertions, 67 deletions

diff --git a/guix/gexp.scm b/guix/gexp.scm
index ce48d8d001..52643bd684 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -85,6 +85,7 @@
             lowered-gexp?
             lowered-gexp-sexp
             lowered-gexp-inputs
+            lowered-gexp-sources
             lowered-gexp-guile
             lowered-gexp-load-path
             lowered-gexp-load-compiled-path
@@ -574,9 +575,9 @@ list."
 
 (define* (lower-inputs inputs
                        #:key system target)
-  "Turn any package from INPUTS into a derivation for SYSTEM; return the
-corresponding input list as a monadic value.  When TARGET is true, use it as
-the cross-compilation target triplet."
+  "Turn any object from INPUTS into a derivation input for SYSTEM or a store
+item (a \"source\"); return the corresponding input list as a monadic value.
+When TARGET is true, use it as the cross-compilation target triplet."
   (define (store-item? obj)
     (and (string? obj) (store-path? obj)))
 
@@ -584,27 +585,30 @@ the cross-compilation target triplet."
     (mapm %store-monad
           (match-lambda
             (((? struct? thing) sub-drv ...)
-             (mlet %store-monad ((drv (lower-object
+             (mlet %store-monad ((obj (lower-object
                                        thing system #:target target)))
-               (return (apply gexp-input drv sub-drv))))
+               (return (match obj
+                         ((? derivation? drv)
+                          (let ((outputs (if (null? sub-drv)
+                                             '("out")
+                                             sub-drv)))
+                            (derivation-input drv outputs)))
+                         ((? store-item? item)
+                          item)))))
             (((? store-item? item))
-             (return (gexp-input item)))
-            (input
-             (return (gexp-input input))))
+             (return item)))
           inputs)))
 
 (define* (lower-reference-graphs graphs #:key system target)
   "Given GRAPHS, a list of (FILE-NAME INPUT ...) lists for use as a
 #:reference-graphs argument, lower it such that each INPUT is replaced by the
-corresponding derivation."
+corresponding <derivation-input> or store item."
   (match graphs
     (((file-names . inputs) ...)
      (mlet %store-monad ((inputs (lower-inputs inputs
                                                #:system system
                                                #:target target)))
-       (return (map (lambda (file input)
-                      (cons file (gexp-input->tuple input)))
-                    file-names inputs))))))
+       (return (map cons file-names inputs))))))
 
 (define* (lower-references lst #:key system target)
   "Based on LST, a list of output names and packages, return a list of output
@@ -637,11 +641,13 @@ names and file names suitable for the #:allowed-references argument to
       ((force proc) system))))
 
 ;; Representation of a gexp instantiated for a given target and system.
+;; It's an intermediate representation between <gexp> and <derivation>.
 (define-record-type <lowered-gexp>
-  (lowered-gexp sexp inputs guile load-path load-compiled-path)
+  (lowered-gexp sexp inputs sources guile load-path load-compiled-path)
   lowered-gexp?
   (sexp                lowered-gexp-sexp)         ;sexp
-  (inputs              lowered-gexp-inputs)       ;list of <gexp-input>
+  (inputs              lowered-gexp-inputs)       ;list of <derivation-input>
+  (sources             lowered-gexp-sources)      ;list of store items
   (guile               lowered-gexp-guile)        ;<derivation> | #f
   (load-path           lowered-gexp-load-path)    ;list of store items
   (load-compiled-path  lowered-gexp-load-compiled-path)) ;list of store items
@@ -740,26 +746,19 @@ derivations--e.g., code evaluated for its side effects."
     (mbegin %store-monad
       (set-grafting graft?)                       ;restore the initial setting
       (return (lowered-gexp sexp
-                            `(,@(if modules
-                                    (list (gexp-input modules))
+                            `(,@(if (derivation? modules)
+                                    (list (derivation-input modules))
                                     '())
                               ,@(if compiled
-                                    (list (gexp-input compiled))
+                                    (list (derivation-input compiled))
                                     '())
-                              ,@(map gexp-input exts)
-                              ,@inputs)
+                              ,@(map derivation-input exts)
+                              ,@(filter derivation-input? inputs))
+                            (filter string? (cons modules inputs))
                             guile
                             load-path
                             load-compiled-path)))))
 
-(define (gexp-input->tuple input)
-  "Given INPUT, a <gexp-input> record, return the corresponding input tuple
-suitable for the 'derivation' procedure."
-  (match (gexp-input-output input)
-    ("out"  `(,(gexp-input-thing input)))
-    (output `(,(gexp-input-thing input)
-              ,(gexp-input-output input)))))
-
 (define* (gexp->derivation name exp
                            #:key
                            system (target 'current)
@@ -830,13 +829,10 @@ The other arguments are as for 'derivation'."
   (define (graphs-file-names graphs)
     ;; Return a list of (FILE-NAME . STORE-PATH) pairs made from GRAPHS.
     (map (match-lambda
-           ;; TODO: Remove 'derivation?' special cases.
-           ((file-name (? derivation? drv))
-            (cons file-name (derivation->output-path drv)))
-           ((file-name (? derivation? drv) sub-drv)
-            (cons file-name (derivation->output-path drv sub-drv)))
-           ((file-name thing)
-            (cons file-name thing)))
+           ((file-name . (? derivation-input? input))
+            (cons file-name (first (derivation-input-output-paths input))))
+           ((file-name . (? string? item))
+            (cons file-name item)))
          graphs))
 
   (define (add-modules exp modules)
@@ -906,13 +902,23 @@ The other arguments are as for 'derivation'."
                       #:outputs outputs
                       #:env-vars env-vars
                       #:system system
-                      #:inputs `((,guile)
-                                 (,builder)
-                                 ,@(map gexp-input->tuple
-                                        (lowered-gexp-inputs lowered))
+                      #:inputs `(,(derivation-input guile '("out"))
+                                 ,@(lowered-gexp-inputs lowered)
                                  ,@(match graphs
-                                     (((_ . inputs) ...) inputs)
-                                     (_ '())))
+                                     (((_ . inputs) ...)
+                                      (filter derivation-input? inputs))
+                                     (#f '())))
+                      #:sources `(,builder
+                                  ,@(if (and (string? modules)
+                                             (store-path? modules))
+                                        (list modules)
+                                        '())
+                                  ,@(lowered-gexp-sources lowered)
+                                  ,@(match graphs
+                                      (((_ . inputs) ...)
+                                       (filter string? inputs))
+                                      (#f '())))
+
                       #:hash hash #:hash-algo hash-algo #:recursive? recursive?
                       #:references-graphs (and=> graphs graphs-file-names)
                       #:allowed-references allowed
diff --git a/guix/remote.scm b/guix/remote.scm
index e503c76167..52ced16871 100644
--- a/guix/remote.scm
+++ b/guix/remote.scm
@@ -95,40 +95,26 @@ remote store."
                       (remote -> (connect-to-remote-daemon session
                                                            socket-name)))
     (define inputs
-      (cons (gexp-input (lowered-gexp-guile lowered))
+      (cons (derivation-input (lowered-gexp-guile lowered))
             (lowered-gexp-inputs lowered)))
 
-    (define to-build
-      (map (lambda (input)
-             (if (derivation? (gexp-input-thing input))
-                 (cons (gexp-input-thing input)
-                       (gexp-input-output input))
-                 (gexp-input-thing input)))
-           inputs))
+    (define sources
+      (lowered-gexp-sources lowered))
 
     (if build-locally?
-        (let ((to-send (map (lambda (input)
-                              (match (gexp-input-thing input)
-                                ((? derivation? drv)
-                                 (derivation->output-path
-                                  drv (gexp-input-output input)))
-                                ((? store-path? item)
-                                 item)))
-                            inputs)))
+        (let ((to-send (append (map derivation-input-output-paths inputs)
+                               sources)))
           (mbegin %store-monad
-            (built-derivations to-build)
+            (built-derivations inputs)
             ((store-lift send-files) to-send remote #:recursive? #t)
             (return (close-connection remote))
             (return (%remote-eval lowered session))))
-        (let ((to-send (map (lambda (input)
-                              (match (gexp-input-thing input)
-                                ((? derivation? drv)
-                                 (derivation-file-name drv))
-                                ((? store-path? item)
-                                 item)))
-                            inputs)))
+        (let ((to-send (append (map (compose derivation-file-name
+                                             derivation-input-derivation)
+                                    inputs)
+                               sources)))
           (mbegin %store-monad
             ((store-lift send-files) to-send remote #:recursive? #t)
-            (return (build-derivations remote to-build))
+            (return (build-derivations remote inputs))
             (return (close-connection remote))
             (return (%remote-eval lowered session)))))))
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 23904fce2e..a1f79e3435 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -849,8 +849,9 @@
                              #:effective-version "2.0")))
     (define (matching-input drv output)
       (lambda (input)
-        (and (eq? (gexp-input-thing input) drv)
-             (string=? (gexp-input-output input) output))))
+        (and (eq? (derivation-input-derivation input) drv)
+             (equal? (derivation-input-sub-derivations input)
+                     (list output)))))
 
     (mbegin %store-monad
       (return (and (find (matching-input extension-drv "out")