@@ -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
@@ -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)))))))
@@ -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")
* 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> --- guix/gexp.scm | 86 ++++++++++++++++++++++++++----------------------- guix/remote.scm | 36 +++++++-------------- tests/gexp.scm | 5 +-- 3 files changed, 60 insertions(+), 67 deletions(-)