From 386857748097619b3b75a7bf93677b6aa742d03c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 9 Jul 2019 23:05:01 +0200 Subject: gexp: separates sources from derivation inputs. * guix/gexp.scm (lower-inputs): Return either records or store items. (lower-reference-graphs): Return file/input pairs. ()[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 records. * guix/remote.scm (remote-eval): Adjust to the new interface. * tests/gexp.scm ("lower-gexp"): Adjust to expect records instead of --- guix/gexp.scm | 86 ++++++++++++++++++++++++++++++++--------------------------- 1 file changed, 46 insertions(+), 40 deletions(-) (limited to 'guix/gexp.scm') 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 @@ (define-module (guix gexp) 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 @@ (define (gexp-extensions gexp) (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 @@ (define (store-item? obj) (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 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 @@ (define default-guile-derivation ((force proc) system)))) ;; Representation of a gexp instantiated for a given target and system. +;; It's an intermediate representation between and . (define-record-type - (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 + (inputs lowered-gexp-inputs) ;list of + (sources lowered-gexp-sources) ;list of store items (guile lowered-gexp-guile) ; | #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 @@ (define load-compiled-path (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 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 @@ (define requested-graft? graft?) (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 @@ (define (add-modules exp modules) #: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 -- cgit v1.2.3 From b9373e262730578ba6c3805ffe44900f10bc655c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 10 Jul 2019 18:39:25 +0200 Subject: gexp: 'lowered-gexp-guile' now returns a . * guix/derivations.scm (derivation-input-output-path): New procedure. * guix/gexp.scm (lower-gexp): Wrap GUILE in a . (gexp->derivation): Adjust accordingly. * guix/remote.scm (remote-pipe-for-gexp, remote-eval): Adjust accordingly. * tests/gexp.scm ("lower-gexp"): Adjust accordingly. --- guix/derivations.scm | 8 ++++++++ guix/gexp.scm | 8 ++++---- guix/remote.scm | 4 ++-- tests/gexp.scm | 3 ++- 4 files changed, 16 insertions(+), 7 deletions(-) (limited to 'guix/gexp.scm') diff --git a/guix/derivations.scm b/guix/derivations.scm index 23d058e832..92d50503ce 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -71,6 +71,7 @@ (define-module (guix derivations) derivation-input-derivation derivation-input-sub-derivations derivation-input-output-paths + derivation-input-output-path valid-derivation-input? &derivation-error @@ -221,6 +222,13 @@ (define (derivation-input-output-paths input) (map (cut derivation->output-path drv <>) sub-drvs)))) +(define (derivation-input-output-path input) + "Return the output file name of INPUT. If INPUT has more than one outputs, +an error is raised." + (match input + (($ drv (output)) + (derivation->output-path drv output)))) + (define (valid-derivation-input? store input) "Return true if INPUT is valid--i.e., if all the outputs it requests are in the store." diff --git a/guix/gexp.scm b/guix/gexp.scm index 52643bd684..eef308b000 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -648,7 +648,7 @@ (define-record-type (sexp lowered-gexp-sexp) ;sexp (inputs lowered-gexp-inputs) ;list of (sources lowered-gexp-sources) ;list of store items - (guile lowered-gexp-guile) ; | #f + (guile lowered-gexp-guile) ; | #f (load-path lowered-gexp-load-path) ;list of store items (load-compiled-path lowered-gexp-load-compiled-path)) ;list of store items @@ -755,7 +755,7 @@ (define load-compiled-path ,@(map derivation-input exts) ,@(filter derivation-input? inputs)) (filter string? (cons modules inputs)) - guile + (derivation-input guile '("out")) load-path load-compiled-path))))) @@ -889,7 +889,7 @@ (define (add-modules exp modules) (mbegin %store-monad (set-grafting graft?) ;restore the initial setting (raw-derivation name - (string-append (derivation->output-path guile) + (string-append (derivation-input-output-path guile) "/bin/guile") `("--no-auto-compile" ,@(append-map (lambda (directory) @@ -902,7 +902,7 @@ (define (add-modules exp modules) #:outputs outputs #:env-vars env-vars #:system system - #:inputs `(,(derivation-input guile '("out")) + #:inputs `(,guile ,@(lowered-gexp-inputs lowered) ,@(match graphs (((_ . inputs) ...) diff --git a/guix/remote.scm b/guix/remote.scm index 52ced16871..d49ee91b38 100644 --- a/guix/remote.scm +++ b/guix/remote.scm @@ -46,7 +46,7 @@ (define shell-quote (compose object->string object->string)) (apply open-remote-pipe* session OPEN_READ - (string-append (derivation->output-path + (string-append (derivation-input-output-path (lowered-gexp-guile lowered)) "/bin/guile") "--no-auto-compile" @@ -95,7 +95,7 @@ (define* (remote-eval exp session (remote -> (connect-to-remote-daemon session socket-name))) (define inputs - (cons (derivation-input (lowered-gexp-guile lowered)) + (cons (lowered-gexp-guile lowered) (lowered-gexp-inputs lowered))) (define sources diff --git a/tests/gexp.scm b/tests/gexp.scm index a1f79e3435..460afe7f59 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -868,7 +868,8 @@ (define (matching-input drv output) "/lib/guile/2.0/site-ccache") (lowered-gexp-load-compiled-path lexp)) (= 2 (length (lowered-gexp-load-compiled-path lexp))) - (eq? (lowered-gexp-guile lexp) (%guile-for-build))))))) + (eq? (derivation-input-derivation (lowered-gexp-guile lexp)) + (%guile-for-build))))))) (test-assertm "gexp->derivation #:references-graphs" (mlet* %store-monad -- cgit v1.2.3