From patchwork Wed Jul 10 17:11:21 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 14564 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id B9923171E2; Wed, 10 Jul 2019 18:13:19 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 48B08171DD for ; Wed, 10 Jul 2019 18:13:19 +0100 (BST) Received: from localhost ([::1]:35544 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hlG9e-000821-Ub for patchwork@mira.cbaines.net; Wed, 10 Jul 2019 13:13:18 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:45362) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hlG9S-0007mb-Ln for guix-patches@gnu.org; Wed, 10 Jul 2019 13:13:09 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hlG9Q-0003AZ-F8 for guix-patches@gnu.org; Wed, 10 Jul 2019 13:13:06 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55958) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hlG9O-00036I-Mr for guix-patches@gnu.org; Wed, 10 Jul 2019 13:13:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hlG9O-0001DA-He for guix-patches@gnu.org; Wed, 10 Jul 2019 13:13:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#36578] [PATCH 2/9] gexp: separates sources from derivation inputs. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 10 Jul 2019 17:13:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 36578 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 36578@debbugs.gnu.org Received: via spool by 36578-submit@debbugs.gnu.org id=B36578.15627787234510 (code B ref 36578); Wed, 10 Jul 2019 17:13:02 +0000 Received: (at 36578) by debbugs.gnu.org; 10 Jul 2019 17:12:03 +0000 Received: from localhost ([127.0.0.1]:36526 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hlG8R-0001Af-57 for submit@debbugs.gnu.org; Wed, 10 Jul 2019 13:12:03 -0400 Received: from eggs.gnu.org ([209.51.188.92]:60793) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hlG8P-00019g-Oh for 36578@debbugs.gnu.org; Wed, 10 Jul 2019 13:12:02 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:47970) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hlG8J-0001wN-TQ; Wed, 10 Jul 2019 13:11:55 -0400 Received: from [81.18.188.212] (port=57592 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1hlG8H-0005OT-K8; Wed, 10 Jul 2019 13:11:55 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Wed, 10 Jul 2019 19:11:21 +0200 Message-Id: <20190710171128.21568-2-ludo@gnu.org> X-Mailer: git-send-email 2.22.0 In-Reply-To: <20190710171128.21568-1-ludo@gnu.org> References: <20190710171128.21568-1-ludo@gnu.org> MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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 ++++++++++++++++++++++++++----------------------- guix/remote.scm | 36 +++++++-------------- tests/gexp.scm | 5 +-- 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 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 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 @@ 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 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")