2013-01-06 00:47:50 +01:00
|
|
|
|
;;; GNU Guix --- Functional package management for GNU
|
2014-01-25 17:04:35 +01:00
|
|
|
|
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
2012-04-18 23:34:12 +02:00
|
|
|
|
;;;
|
2013-01-06 00:47:50 +01:00
|
|
|
|
;;; This file is part of GNU Guix.
|
2012-04-18 23:34:12 +02:00
|
|
|
|
;;;
|
2013-01-06 00:47:50 +01:00
|
|
|
|
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
2012-04-18 23:34:12 +02:00
|
|
|
|
;;; under the terms of the GNU General Public License as published by
|
|
|
|
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
|
|
|
|
;;; your option) any later version.
|
|
|
|
|
;;;
|
2013-01-06 00:47:50 +01:00
|
|
|
|
;;; GNU Guix is distributed in the hope that it will be useful, but
|
2012-04-18 23:34:12 +02:00
|
|
|
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
;;; GNU General Public License for more details.
|
|
|
|
|
;;;
|
|
|
|
|
;;; You should have received a copy of the GNU General Public License
|
2013-01-06 00:47:50 +01:00
|
|
|
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
2012-04-18 23:34:12 +02:00
|
|
|
|
|
|
|
|
|
(define-module (guix derivations)
|
|
|
|
|
#:use-module (srfi srfi-1)
|
|
|
|
|
#:use-module (srfi srfi-9)
|
2013-09-18 11:10:02 +02:00
|
|
|
|
#:use-module (srfi srfi-9 gnu)
|
2012-04-18 23:34:12 +02:00
|
|
|
|
#:use-module (srfi srfi-26)
|
|
|
|
|
#:use-module (rnrs io ports)
|
|
|
|
|
#:use-module (rnrs bytevectors)
|
|
|
|
|
#:use-module (ice-9 match)
|
|
|
|
|
#:use-module (ice-9 rdelim)
|
2013-11-13 00:25:57 +01:00
|
|
|
|
#:use-module (ice-9 vlist)
|
2012-06-01 23:29:55 +02:00
|
|
|
|
#:use-module (guix store)
|
2012-06-01 23:29:55 +02:00
|
|
|
|
#:use-module (guix utils)
|
2013-07-01 23:28:21 +02:00
|
|
|
|
#:use-module (guix hash)
|
Move base32 code to (guix base32).
* guix/utils.scm (bytevector-quintet-ref, bytevector-quintet-ref-right,
bytevector-quintet-length, bytevector-quintet-fold,
bytevector-quintet-fold-right, make-bytevector->base32-string,
%nix-base32-chars, %rfc4648-base32-chars, bytevector->base32-string,
bytevector->nix-base32-string, bytevector-quintet-set!,
bytevector-quintet-set-right!, base32-string-unfold,
base32-string-unfold-right, make-base32-string->bytevector,
base32-string->bytevector, nix-base32-string->bytevector): Move to...
* guix/base32.scm: ... here. New file.
* tests/utils.scm (%nix-hash, "bytevector->base32-string",
"base32-string->bytevector", "nix-base32-string->bytevector", "sha256
& bytevector->base32-string"): Move to...
* tests/base32.scm: ... here. New file
* guix-download.in, guix/derivations.scm, guix/packages.scm,
guix/snix.scm, tests/builders.scm, tests/derivations.scm: Adjust
accordingly.
* guix.scm (%public-modules): Add `base32'.
2012-11-11 22:33:28 +01:00
|
|
|
|
#:use-module (guix base32)
|
2012-07-01 00:37:03 +02:00
|
|
|
|
#:export (<derivation>
|
|
|
|
|
derivation?
|
2012-04-18 23:34:12 +02:00
|
|
|
|
derivation-outputs
|
|
|
|
|
derivation-inputs
|
|
|
|
|
derivation-sources
|
|
|
|
|
derivation-system
|
|
|
|
|
derivation-builder-arguments
|
|
|
|
|
derivation-builder-environment-vars
|
2013-09-17 23:00:55 +02:00
|
|
|
|
derivation-file-name
|
2012-07-01 00:37:03 +02:00
|
|
|
|
derivation-prerequisites
|
|
|
|
|
derivation-prerequisites-to-build
|
2012-04-18 23:34:12 +02:00
|
|
|
|
|
2012-07-01 00:37:03 +02:00
|
|
|
|
<derivation-output>
|
2012-04-18 23:34:12 +02:00
|
|
|
|
derivation-output?
|
|
|
|
|
derivation-output-path
|
|
|
|
|
derivation-output-hash-algo
|
|
|
|
|
derivation-output-hash
|
2014-02-21 23:03:19 +01:00
|
|
|
|
derivation-output-recursive?
|
2012-04-18 23:34:12 +02:00
|
|
|
|
|
2012-07-01 00:37:03 +02:00
|
|
|
|
<derivation-input>
|
2012-04-18 23:34:12 +02:00
|
|
|
|
derivation-input?
|
|
|
|
|
derivation-input-path
|
|
|
|
|
derivation-input-sub-derivations
|
2013-04-17 00:06:59 +02:00
|
|
|
|
derivation-input-output-paths
|
2012-04-18 23:34:12 +02:00
|
|
|
|
|
|
|
|
|
fixed-output-derivation?
|
2012-04-19 23:09:55 +02:00
|
|
|
|
derivation-hash
|
|
|
|
|
|
|
|
|
|
read-derivation
|
2012-06-01 23:29:55 +02:00
|
|
|
|
write-derivation
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 17:01:40 +02:00
|
|
|
|
derivation->output-path
|
|
|
|
|
derivation->output-paths
|
2012-06-07 23:15:00 +02:00
|
|
|
|
derivation-path->output-path
|
2013-01-05 23:51:13 +01:00
|
|
|
|
derivation-path->output-paths
|
2012-06-08 21:31:01 +02:00
|
|
|
|
derivation
|
2014-10-07 23:23:09 +02:00
|
|
|
|
graft-derivation
|
2013-11-13 00:25:57 +01:00
|
|
|
|
map-derivation
|
2012-06-08 21:31:01 +02:00
|
|
|
|
|
|
|
|
|
%guile-for-build
|
2013-08-28 23:59:14 +02:00
|
|
|
|
imported-modules
|
|
|
|
|
compiled-modules
|
2012-06-11 23:12:55 +02:00
|
|
|
|
build-expression->derivation
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 17:01:40 +02:00
|
|
|
|
imported-files)
|
|
|
|
|
#:replace (build-derivations))
|
2012-04-18 23:34:12 +02:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; Nix derivations, as implemented in Nix's `derivations.cc'.
|
|
|
|
|
;;;
|
|
|
|
|
|
|
|
|
|
(define-record-type <derivation>
|
2013-09-17 23:00:55 +02:00
|
|
|
|
(make-derivation outputs inputs sources system builder args env-vars
|
|
|
|
|
file-name)
|
2012-04-18 23:34:12 +02:00
|
|
|
|
derivation?
|
|
|
|
|
(outputs derivation-outputs) ; list of name/<derivation-output> pairs
|
|
|
|
|
(inputs derivation-inputs) ; list of <derivation-input>
|
|
|
|
|
(sources derivation-sources) ; list of store paths
|
|
|
|
|
(system derivation-system) ; string
|
|
|
|
|
(builder derivation-builder) ; store path
|
|
|
|
|
(args derivation-builder-arguments) ; list of strings
|
2013-09-17 23:00:55 +02:00
|
|
|
|
(env-vars derivation-builder-environment-vars) ; list of name/value pairs
|
|
|
|
|
(file-name derivation-file-name)) ; the .drv file name
|
2012-04-18 23:34:12 +02:00
|
|
|
|
|
|
|
|
|
(define-record-type <derivation-output>
|
2014-02-21 23:03:19 +01:00
|
|
|
|
(make-derivation-output path hash-algo hash recursive?)
|
2012-04-18 23:34:12 +02:00
|
|
|
|
derivation-output?
|
|
|
|
|
(path derivation-output-path) ; store path
|
|
|
|
|
(hash-algo derivation-output-hash-algo) ; symbol | #f
|
2014-02-21 23:03:19 +01:00
|
|
|
|
(hash derivation-output-hash) ; bytevector | #f
|
|
|
|
|
(recursive? derivation-output-recursive?)) ; Boolean
|
2012-04-18 23:34:12 +02:00
|
|
|
|
|
|
|
|
|
(define-record-type <derivation-input>
|
|
|
|
|
(make-derivation-input path sub-derivations)
|
|
|
|
|
derivation-input?
|
|
|
|
|
(path derivation-input-path) ; store path
|
|
|
|
|
(sub-derivations derivation-input-sub-derivations)) ; list of strings
|
|
|
|
|
|
2013-09-18 11:10:02 +02:00
|
|
|
|
(set-record-type-printer! <derivation>
|
|
|
|
|
(lambda (drv port)
|
|
|
|
|
(format port "#<derivation ~a => ~a ~a>"
|
|
|
|
|
(derivation-file-name drv)
|
|
|
|
|
(string-join
|
|
|
|
|
(map (match-lambda
|
|
|
|
|
((_ . output)
|
|
|
|
|
(derivation-output-path output)))
|
|
|
|
|
(derivation-outputs drv)))
|
|
|
|
|
(number->string (object-address drv) 16))))
|
|
|
|
|
|
2012-04-18 23:34:12 +02:00
|
|
|
|
(define (fixed-output-derivation? drv)
|
|
|
|
|
"Return #t if DRV is a fixed-output derivation, such as the result of a
|
|
|
|
|
download with a fixed hash (aka. `fetchurl')."
|
|
|
|
|
(match drv
|
|
|
|
|
(($ <derivation>
|
2014-04-13 00:42:07 +02:00
|
|
|
|
(("out" . ($ <derivation-output> _ (? symbol?) (? bytevector?)))))
|
2012-04-18 23:34:12 +02:00
|
|
|
|
#t)
|
|
|
|
|
(_ #f)))
|
|
|
|
|
|
2013-04-17 00:06:59 +02:00
|
|
|
|
(define (derivation-input-output-paths input)
|
|
|
|
|
"Return the list of output paths corresponding to INPUT, a
|
|
|
|
|
<derivation-input>."
|
|
|
|
|
(match input
|
|
|
|
|
(($ <derivation-input> path sub-drvs)
|
|
|
|
|
(map (cut derivation-path->output-path path <>)
|
|
|
|
|
sub-drvs))))
|
|
|
|
|
|
2012-07-01 00:37:03 +02:00
|
|
|
|
(define (derivation-prerequisites drv)
|
|
|
|
|
"Return the list of derivation-inputs required to build DRV, recursively."
|
|
|
|
|
(let loop ((drv drv)
|
|
|
|
|
(result '()))
|
|
|
|
|
(let ((inputs (remove (cut member <> result) ; XXX: quadratic
|
|
|
|
|
(derivation-inputs drv))))
|
|
|
|
|
(fold loop
|
|
|
|
|
(append inputs result)
|
|
|
|
|
(map (lambda (i)
|
|
|
|
|
(call-with-input-file (derivation-input-path i)
|
|
|
|
|
read-derivation))
|
|
|
|
|
inputs)))))
|
|
|
|
|
|
2013-01-09 08:38:57 +01:00
|
|
|
|
(define* (derivation-prerequisites-to-build store drv
|
2013-04-17 00:06:59 +02:00
|
|
|
|
#:key
|
|
|
|
|
(outputs
|
|
|
|
|
(map
|
|
|
|
|
car
|
|
|
|
|
(derivation-outputs drv)))
|
|
|
|
|
(use-substitutes? #t))
|
|
|
|
|
"Return two values: the list of derivation-inputs required to build the
|
|
|
|
|
OUTPUTS of DRV and not already available in STORE, recursively, and the list
|
|
|
|
|
of required store paths that can be substituted. When USE-SUBSTITUTES? is #f,
|
|
|
|
|
that second value is the empty list."
|
|
|
|
|
(define (derivation-output-paths drv sub-drvs)
|
|
|
|
|
(match drv
|
|
|
|
|
(($ <derivation> outputs)
|
|
|
|
|
(map (lambda (sub-drv)
|
|
|
|
|
(derivation-output-path (assoc-ref outputs sub-drv)))
|
|
|
|
|
sub-drvs))))
|
|
|
|
|
|
2013-01-09 08:38:57 +01:00
|
|
|
|
(define built?
|
|
|
|
|
(cut valid-path? store <>))
|
|
|
|
|
|
2013-04-17 00:06:59 +02:00
|
|
|
|
(define substitutable?
|
|
|
|
|
;; Return true if the given path is substitutable. Call
|
|
|
|
|
;; `substitutable-paths' upfront, to benefit from parallelism in the
|
|
|
|
|
;; substituter.
|
|
|
|
|
(if use-substitutes?
|
|
|
|
|
(let ((s (substitutable-paths store
|
|
|
|
|
(append
|
|
|
|
|
(derivation-output-paths drv outputs)
|
|
|
|
|
(append-map
|
|
|
|
|
derivation-input-output-paths
|
|
|
|
|
(derivation-prerequisites drv))))))
|
|
|
|
|
(cut member <> s))
|
|
|
|
|
(const #f)))
|
|
|
|
|
|
2012-07-01 00:37:03 +02:00
|
|
|
|
(define input-built?
|
2013-04-17 00:06:59 +02:00
|
|
|
|
(compose (cut any built? <>) derivation-input-output-paths))
|
|
|
|
|
|
|
|
|
|
(define input-substitutable?
|
|
|
|
|
;; Return true if and only if all of SUB-DRVS are subsitutable. If at
|
|
|
|
|
;; least one is missing, then everything must be rebuilt.
|
|
|
|
|
(compose (cut every substitutable? <>) derivation-input-output-paths))
|
2013-01-09 08:38:57 +01:00
|
|
|
|
|
|
|
|
|
(define (derivation-built? drv sub-drvs)
|
2013-04-17 00:06:59 +02:00
|
|
|
|
(every built? (derivation-output-paths drv sub-drvs)))
|
|
|
|
|
|
|
|
|
|
(define (derivation-substitutable? drv sub-drvs)
|
|
|
|
|
(every substitutable? (derivation-output-paths drv sub-drvs)))
|
|
|
|
|
|
|
|
|
|
(let loop ((drv drv)
|
|
|
|
|
(sub-drvs outputs)
|
|
|
|
|
(build '())
|
|
|
|
|
(substitute '()))
|
|
|
|
|
(cond ((derivation-built? drv sub-drvs)
|
|
|
|
|
(values build substitute))
|
|
|
|
|
((derivation-substitutable? drv sub-drvs)
|
|
|
|
|
(values build
|
|
|
|
|
(append (derivation-output-paths drv sub-drvs)
|
|
|
|
|
substitute)))
|
|
|
|
|
(else
|
|
|
|
|
(let ((inputs (remove (lambda (i)
|
|
|
|
|
(or (member i build) ; XXX: quadratic
|
|
|
|
|
(input-built? i)
|
|
|
|
|
(input-substitutable? i)))
|
|
|
|
|
(derivation-inputs drv))))
|
|
|
|
|
(fold2 loop
|
|
|
|
|
(append inputs build)
|
|
|
|
|
(append (append-map (lambda (input)
|
|
|
|
|
(if (and (not (input-built? input))
|
|
|
|
|
(input-substitutable? input))
|
|
|
|
|
(derivation-input-output-paths
|
|
|
|
|
input)
|
|
|
|
|
'()))
|
|
|
|
|
(derivation-inputs drv))
|
|
|
|
|
substitute)
|
|
|
|
|
(map (lambda (i)
|
|
|
|
|
(call-with-input-file (derivation-input-path i)
|
|
|
|
|
read-derivation))
|
|
|
|
|
inputs)
|
|
|
|
|
(map derivation-input-sub-derivations inputs)))))))
|
2012-07-01 00:37:03 +02:00
|
|
|
|
|
2013-01-30 18:56:20 +01:00
|
|
|
|
(define (%read-derivation drv-port)
|
|
|
|
|
;; Actually read derivation from DRV-PORT.
|
2012-04-18 23:34:12 +02:00
|
|
|
|
|
|
|
|
|
(define comma (string->symbol ","))
|
|
|
|
|
|
|
|
|
|
(define (ununquote x)
|
|
|
|
|
(match x
|
|
|
|
|
(('unquote x) (ununquote x))
|
|
|
|
|
((x ...) (map ununquote x))
|
|
|
|
|
(_ x)))
|
|
|
|
|
|
|
|
|
|
(define (outputs->alist x)
|
|
|
|
|
(fold-right (lambda (output result)
|
|
|
|
|
(match output
|
|
|
|
|
((name path "" "")
|
|
|
|
|
(alist-cons name
|
2014-02-21 23:03:19 +01:00
|
|
|
|
(make-derivation-output path #f #f #f)
|
2012-04-18 23:34:12 +02:00
|
|
|
|
result))
|
|
|
|
|
((name path hash-algo hash)
|
|
|
|
|
;; fixed-output
|
2014-02-21 23:03:19 +01:00
|
|
|
|
(let* ((rec? (string-prefix? "r:" hash-algo))
|
|
|
|
|
(algo (string->symbol
|
|
|
|
|
(if rec?
|
|
|
|
|
(string-drop hash-algo 2)
|
|
|
|
|
hash-algo)))
|
|
|
|
|
(hash (base16-string->bytevector hash)))
|
2012-04-18 23:34:12 +02:00
|
|
|
|
(alist-cons name
|
2014-02-21 23:03:19 +01:00
|
|
|
|
(make-derivation-output path algo
|
|
|
|
|
hash rec?)
|
2012-04-18 23:34:12 +02:00
|
|
|
|
result)))))
|
|
|
|
|
'()
|
|
|
|
|
x))
|
|
|
|
|
|
|
|
|
|
(define (make-input-drvs x)
|
|
|
|
|
(fold-right (lambda (input result)
|
|
|
|
|
(match input
|
|
|
|
|
((path (sub-drvs ...))
|
|
|
|
|
(cons (make-derivation-input path sub-drvs)
|
|
|
|
|
result))))
|
|
|
|
|
'()
|
|
|
|
|
x))
|
|
|
|
|
|
2012-10-06 01:24:46 +02:00
|
|
|
|
;; The contents of a derivation are typically ASCII, but choosing
|
|
|
|
|
;; UTF-8 allows us to take the fast path for Guile's `scm_getc'.
|
|
|
|
|
(set-port-encoding! drv-port "UTF-8")
|
|
|
|
|
|
2012-04-18 23:34:12 +02:00
|
|
|
|
(let loop ((exp (read drv-port))
|
|
|
|
|
(result '()))
|
|
|
|
|
(match exp
|
|
|
|
|
((? eof-object?)
|
|
|
|
|
(let ((result (reverse result)))
|
|
|
|
|
(match result
|
|
|
|
|
(('Derive ((outputs ...) (input-drvs ...)
|
|
|
|
|
(input-srcs ...)
|
|
|
|
|
(? string? system)
|
|
|
|
|
(? string? builder)
|
|
|
|
|
((? string? args) ...)
|
|
|
|
|
((var value) ...)))
|
|
|
|
|
(make-derivation (outputs->alist outputs)
|
|
|
|
|
(make-input-drvs input-drvs)
|
|
|
|
|
input-srcs
|
|
|
|
|
system builder args
|
2013-09-17 23:00:55 +02:00
|
|
|
|
(fold-right alist-cons '() var value)
|
|
|
|
|
(port-filename drv-port)))
|
2012-04-18 23:34:12 +02:00
|
|
|
|
(_
|
|
|
|
|
(error "failed to parse derivation" drv-port result)))))
|
|
|
|
|
((? (cut eq? <> comma))
|
|
|
|
|
(loop (read drv-port) result))
|
|
|
|
|
(_
|
|
|
|
|
(loop (read drv-port)
|
|
|
|
|
(cons (ununquote exp) result))))))
|
|
|
|
|
|
2013-01-30 18:56:20 +01:00
|
|
|
|
(define read-derivation
|
|
|
|
|
(let ((cache (make-weak-value-hash-table 200)))
|
|
|
|
|
(lambda (drv-port)
|
|
|
|
|
"Read the derivation from DRV-PORT and return the corresponding
|
|
|
|
|
<derivation> object."
|
|
|
|
|
;; Memoize that operation because `%read-derivation' is quite expensive,
|
|
|
|
|
;; and because the same argument is read more than 15 times on average
|
|
|
|
|
;; during something like (package-derivation s gdb).
|
|
|
|
|
(let ((file (and=> (port-filename drv-port) basename)))
|
|
|
|
|
(or (and file (hash-ref cache file))
|
|
|
|
|
(let ((drv (%read-derivation drv-port)))
|
|
|
|
|
(hash-set! cache file drv)
|
|
|
|
|
drv))))))
|
|
|
|
|
|
2013-03-16 16:46:46 +01:00
|
|
|
|
(define-inlinable (write-sequence lst write-item port)
|
|
|
|
|
;; Write each element of LST with WRITE-ITEM to PORT, separating them with a
|
|
|
|
|
;; comma.
|
|
|
|
|
(match lst
|
|
|
|
|
(()
|
|
|
|
|
#t)
|
|
|
|
|
((prefix (... ...) last)
|
|
|
|
|
(for-each (lambda (item)
|
|
|
|
|
(write-item item port)
|
|
|
|
|
(display "," port))
|
|
|
|
|
prefix)
|
|
|
|
|
(write-item last port))))
|
|
|
|
|
|
|
|
|
|
(define-inlinable (write-list lst write-item port)
|
|
|
|
|
;; Write LST as a derivation list to PORT, using WRITE-ITEM to write each
|
|
|
|
|
;; element.
|
|
|
|
|
(display "[" port)
|
|
|
|
|
(write-sequence lst write-item port)
|
|
|
|
|
(display "]" port))
|
|
|
|
|
|
|
|
|
|
(define-inlinable (write-tuple lst write-item port)
|
|
|
|
|
;; Same, but write LST as a tuple.
|
|
|
|
|
(display "(" port)
|
|
|
|
|
(write-sequence lst write-item port)
|
|
|
|
|
(display ")" port))
|
|
|
|
|
|
2012-04-18 23:34:12 +02:00
|
|
|
|
(define (write-derivation drv port)
|
|
|
|
|
"Write the ATerm-like serialization of DRV to PORT. See Section 2.4 of
|
|
|
|
|
Eelco Dolstra's PhD dissertation for an overview of a previous version of
|
|
|
|
|
that form."
|
2012-09-01 19:21:06 +02:00
|
|
|
|
|
|
|
|
|
;; Make sure we're using the faster implementation.
|
|
|
|
|
(define format simple-format)
|
|
|
|
|
|
2013-03-16 16:46:46 +01:00
|
|
|
|
(define (write-string-list lst)
|
|
|
|
|
(write-list lst write port))
|
2012-04-18 23:34:12 +02:00
|
|
|
|
|
2012-07-02 01:23:39 +02:00
|
|
|
|
(define (coalesce-duplicate-inputs inputs)
|
|
|
|
|
;; Return a list of inputs, such that when INPUTS contains the same DRV
|
|
|
|
|
;; twice, they are coalesced, with their sub-derivations merged. This is
|
|
|
|
|
;; needed because Nix itself keeps only one of them.
|
|
|
|
|
(fold (lambda (input result)
|
|
|
|
|
(match input
|
|
|
|
|
(($ <derivation-input> path sub-drvs)
|
|
|
|
|
;; XXX: quadratic
|
|
|
|
|
(match (find (match-lambda
|
|
|
|
|
(($ <derivation-input> p s)
|
|
|
|
|
(string=? p path)))
|
|
|
|
|
result)
|
|
|
|
|
(#f
|
|
|
|
|
(cons input result))
|
|
|
|
|
((and dup ($ <derivation-input> _ sub-drvs2))
|
|
|
|
|
;; Merge DUP with INPUT.
|
|
|
|
|
(let ((sub-drvs (delete-duplicates
|
|
|
|
|
(append sub-drvs sub-drvs2))))
|
|
|
|
|
(cons (make-derivation-input path sub-drvs)
|
|
|
|
|
(delq dup result))))))))
|
|
|
|
|
'()
|
|
|
|
|
inputs))
|
|
|
|
|
|
2013-03-16 16:46:46 +01:00
|
|
|
|
(define (write-output output port)
|
|
|
|
|
(match output
|
2014-02-21 23:03:19 +01:00
|
|
|
|
((name . ($ <derivation-output> path hash-algo hash recursive?))
|
2013-03-16 16:46:46 +01:00
|
|
|
|
(write-tuple (list name path
|
2014-02-21 23:03:19 +01:00
|
|
|
|
(if hash-algo
|
|
|
|
|
(string-append (if recursive? "r:" "")
|
|
|
|
|
(symbol->string hash-algo))
|
|
|
|
|
"")
|
2013-03-16 16:46:46 +01:00
|
|
|
|
(or (and=> hash bytevector->base16-string)
|
|
|
|
|
""))
|
|
|
|
|
write
|
|
|
|
|
port))))
|
|
|
|
|
|
|
|
|
|
(define (write-input input port)
|
|
|
|
|
(match input
|
|
|
|
|
(($ <derivation-input> path sub-drvs)
|
|
|
|
|
(display "(" port)
|
|
|
|
|
(write path port)
|
|
|
|
|
(display "," port)
|
|
|
|
|
(write-string-list (sort sub-drvs string<?))
|
|
|
|
|
(display ")" port))))
|
|
|
|
|
|
|
|
|
|
(define (write-env-var env-var port)
|
|
|
|
|
(match env-var
|
|
|
|
|
((name . value)
|
|
|
|
|
(display "(" port)
|
|
|
|
|
(write name port)
|
|
|
|
|
(display "," port)
|
|
|
|
|
(write value port)
|
|
|
|
|
(display ")" port))))
|
|
|
|
|
|
2012-07-01 22:55:49 +02:00
|
|
|
|
;; Note: lists are sorted alphabetically, to conform with the behavior of
|
|
|
|
|
;; C++ `std::map' in Nix itself.
|
|
|
|
|
|
2012-04-18 23:34:12 +02:00
|
|
|
|
(match drv
|
|
|
|
|
(($ <derivation> outputs inputs sources
|
|
|
|
|
system builder args env-vars)
|
|
|
|
|
(display "Derive(" port)
|
2013-03-16 16:46:46 +01:00
|
|
|
|
(write-list (sort outputs
|
|
|
|
|
(lambda (o1 o2)
|
|
|
|
|
(string<? (car o1) (car o2))))
|
|
|
|
|
write-output
|
|
|
|
|
port)
|
2012-04-18 23:34:12 +02:00
|
|
|
|
(display "," port)
|
2013-03-16 16:46:46 +01:00
|
|
|
|
(write-list (sort (coalesce-duplicate-inputs inputs)
|
|
|
|
|
(lambda (i1 i2)
|
|
|
|
|
(string<? (derivation-input-path i1)
|
|
|
|
|
(derivation-input-path i2))))
|
|
|
|
|
write-input
|
|
|
|
|
port)
|
2012-04-18 23:34:12 +02:00
|
|
|
|
(display "," port)
|
2013-03-16 16:46:46 +01:00
|
|
|
|
(write-string-list (sort sources string<?))
|
2012-04-18 23:34:12 +02:00
|
|
|
|
(format port ",~s,~s," system builder)
|
2013-03-16 16:46:46 +01:00
|
|
|
|
(write-string-list args)
|
2012-04-18 23:34:12 +02:00
|
|
|
|
(display "," port)
|
2013-03-16 16:46:46 +01:00
|
|
|
|
(write-list (sort env-vars
|
|
|
|
|
(lambda (e1 e2)
|
|
|
|
|
(string<? (car e1) (car e2))))
|
|
|
|
|
write-env-var
|
|
|
|
|
port)
|
2012-04-18 23:34:12 +02:00
|
|
|
|
(display ")" port))))
|
|
|
|
|
|
2014-04-29 18:13:10 +02:00
|
|
|
|
(define derivation->string
|
|
|
|
|
(memoize
|
|
|
|
|
(lambda (drv)
|
|
|
|
|
"Return the external representation of DRV as a string."
|
|
|
|
|
(with-fluids ((%default-port-encoding "UTF-8"))
|
|
|
|
|
(call-with-output-string
|
|
|
|
|
(cut write-derivation drv <>))))))
|
|
|
|
|
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 17:01:40 +02:00
|
|
|
|
(define* (derivation->output-path drv #:optional (output "out"))
|
|
|
|
|
"Return the store path of its output OUTPUT."
|
|
|
|
|
(let ((outputs (derivation-outputs drv)))
|
|
|
|
|
(and=> (assoc-ref outputs output) derivation-output-path)))
|
|
|
|
|
|
|
|
|
|
(define (derivation->output-paths drv)
|
|
|
|
|
"Return the list of name/path pairs of the outputs of DRV."
|
|
|
|
|
(map (match-lambda
|
|
|
|
|
((name . output)
|
|
|
|
|
(cons name (derivation-output-path output))))
|
|
|
|
|
(derivation-outputs drv)))
|
|
|
|
|
|
2012-09-01 19:21:06 +02:00
|
|
|
|
(define derivation-path->output-path
|
|
|
|
|
;; This procedure is called frequently, so memoize it.
|
|
|
|
|
(memoize
|
|
|
|
|
(lambda* (path #:optional (output "out"))
|
2014-03-10 23:58:40 +01:00
|
|
|
|
"Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the store
|
2012-06-07 23:15:00 +02:00
|
|
|
|
path of its output OUTPUT."
|
2013-10-30 19:09:32 +01:00
|
|
|
|
(derivation->output-path (call-with-input-file path read-derivation)
|
|
|
|
|
output))))
|
2012-06-07 23:15:00 +02:00
|
|
|
|
|
2013-01-05 23:51:13 +01:00
|
|
|
|
(define (derivation-path->output-paths path)
|
2014-03-10 23:58:40 +01:00
|
|
|
|
"Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the
|
2013-01-05 23:51:13 +01:00
|
|
|
|
list of name/path pairs of its outputs."
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 17:01:40 +02:00
|
|
|
|
(derivation->output-paths (call-with-input-file path read-derivation)))
|
2013-01-05 23:51:13 +01:00
|
|
|
|
|
2012-06-07 23:15:00 +02:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; Derivation primitive.
|
|
|
|
|
;;;
|
|
|
|
|
|
2012-06-01 23:29:55 +02:00
|
|
|
|
(define (compressed-hash bv size) ; `compressHash'
|
|
|
|
|
"Given the hash stored in BV, return a compressed version thereof that fits
|
|
|
|
|
in SIZE bytes."
|
|
|
|
|
(define new (make-bytevector size 0))
|
|
|
|
|
(define old-size (bytevector-length bv))
|
|
|
|
|
(let loop ((i 0))
|
|
|
|
|
(if (= i old-size)
|
|
|
|
|
new
|
|
|
|
|
(let* ((j (modulo i size))
|
|
|
|
|
(o (bytevector-u8-ref new j)))
|
|
|
|
|
(bytevector-u8-set! new j
|
|
|
|
|
(logxor o (bytevector-u8-ref bv i)))
|
|
|
|
|
(loop (+ 1 i))))))
|
2012-04-18 23:34:12 +02:00
|
|
|
|
|
2012-06-07 23:15:00 +02:00
|
|
|
|
(define derivation-hash ; `hashDerivationModulo' in derivations.cc
|
|
|
|
|
(memoize
|
|
|
|
|
(lambda (drv)
|
|
|
|
|
"Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
|
|
|
|
|
(match drv
|
|
|
|
|
(($ <derivation> ((_ . ($ <derivation-output> path
|
2014-02-21 23:03:19 +01:00
|
|
|
|
(? symbol? hash-algo) (? bytevector? hash)
|
|
|
|
|
(? boolean? recursive?)))))
|
2012-06-07 23:15:00 +02:00
|
|
|
|
;; A fixed-output derivation.
|
2012-04-18 23:34:12 +02:00
|
|
|
|
(sha256
|
2012-06-07 23:15:00 +02:00
|
|
|
|
(string->utf8
|
2014-02-21 23:03:19 +01:00
|
|
|
|
(string-append "fixed:out:"
|
|
|
|
|
(if recursive? "r:" "")
|
|
|
|
|
(symbol->string hash-algo)
|
2012-06-09 18:49:19 +02:00
|
|
|
|
":" (bytevector->base16-string hash)
|
|
|
|
|
":" path))))
|
2012-06-07 23:15:00 +02:00
|
|
|
|
(($ <derivation> outputs inputs sources
|
|
|
|
|
system builder args env-vars)
|
|
|
|
|
;; A regular derivation: replace the path of each input with that
|
|
|
|
|
;; input's hash; return the hash of serialization of the resulting
|
2012-07-01 22:55:49 +02:00
|
|
|
|
;; derivation.
|
|
|
|
|
(let* ((inputs (map (match-lambda
|
|
|
|
|
(($ <derivation-input> path sub-drvs)
|
|
|
|
|
(let ((hash (call-with-input-file path
|
|
|
|
|
(compose bytevector->base16-string
|
|
|
|
|
derivation-hash
|
|
|
|
|
read-derivation))))
|
|
|
|
|
(make-derivation-input hash sub-drvs))))
|
|
|
|
|
inputs))
|
|
|
|
|
(drv (make-derivation outputs inputs sources
|
2013-09-17 23:00:55 +02:00
|
|
|
|
system builder args env-vars
|
|
|
|
|
#f)))
|
2013-07-03 01:17:11 +02:00
|
|
|
|
|
|
|
|
|
;; XXX: At this point this remains faster than `port-sha256', because
|
|
|
|
|
;; the SHA256 port's `write' method gets called for every single
|
|
|
|
|
;; character.
|
2012-06-07 23:15:00 +02:00
|
|
|
|
(sha256
|
2014-04-29 18:13:10 +02:00
|
|
|
|
(string->utf8 (derivation->string drv)))))))))
|
2012-04-18 23:34:12 +02:00
|
|
|
|
|
2012-06-01 23:29:55 +02:00
|
|
|
|
(define (store-path type hash name) ; makeStorePath
|
|
|
|
|
"Return the store path for NAME/HASH/TYPE."
|
|
|
|
|
(let* ((s (string-append type ":sha256:"
|
|
|
|
|
(bytevector->base16-string hash) ":"
|
|
|
|
|
(%store-prefix) ":" name))
|
|
|
|
|
(h (sha256 (string->utf8 s)))
|
|
|
|
|
(c (compressed-hash h 20)))
|
|
|
|
|
(string-append (%store-prefix) "/"
|
|
|
|
|
(bytevector->nix-base32-string c) "-"
|
|
|
|
|
name)))
|
|
|
|
|
|
|
|
|
|
(define (output-path output hash name) ; makeOutputPath
|
|
|
|
|
"Return an output path for OUTPUT (the name of the output as a string) of
|
|
|
|
|
the derivation called NAME with hash HASH."
|
|
|
|
|
(store-path (string-append "output:" output) hash
|
|
|
|
|
(if (string=? output "out")
|
|
|
|
|
name
|
|
|
|
|
(string-append name "-" output))))
|
|
|
|
|
|
2014-02-21 23:03:19 +01:00
|
|
|
|
(define (fixed-output-path output hash-algo hash recursive? name)
|
|
|
|
|
"Return an output path for the fixed output OUTPUT defined by HASH of type
|
|
|
|
|
HASH-ALGO, of the derivation NAME. RECURSIVE? has the same meaning as for
|
|
|
|
|
'add-to-store'."
|
|
|
|
|
(if (and recursive? (eq? hash-algo 'sha256))
|
|
|
|
|
(store-path "source" hash name)
|
|
|
|
|
(let ((tag (string-append "fixed:" output ":"
|
|
|
|
|
(if recursive? "r:" "")
|
|
|
|
|
(symbol->string hash-algo) ":"
|
|
|
|
|
(bytevector->base16-string hash) ":")))
|
|
|
|
|
(store-path (string-append "output:" output)
|
|
|
|
|
(sha256 (string->utf8 tag))
|
|
|
|
|
name))))
|
|
|
|
|
|
2013-08-26 22:11:04 +02:00
|
|
|
|
(define* (derivation store name builder args
|
|
|
|
|
#:key
|
|
|
|
|
(system (%current-system)) (env-vars '())
|
|
|
|
|
(inputs '()) (outputs '("out"))
|
2014-02-21 23:48:56 +01:00
|
|
|
|
hash hash-algo recursive?
|
2014-06-01 23:32:26 +02:00
|
|
|
|
references-graphs allowed-references
|
2014-01-25 17:04:35 +01:00
|
|
|
|
local-build?)
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 17:01:40 +02:00
|
|
|
|
"Build a derivation with the given arguments, and return the resulting
|
2014-02-21 23:48:56 +01:00
|
|
|
|
<derivation> object. When HASH and HASH-ALGO are given, a
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 17:01:40 +02:00
|
|
|
|
fixed-output derivation is created---i.e., one whose result is known in
|
2014-02-21 23:03:19 +01:00
|
|
|
|
advance, such as a file download. If, in addition, RECURSIVE? is true, then
|
|
|
|
|
that fixed output may be an executable file or a directory and HASH must be
|
|
|
|
|
the hash of an archive containing this output.
|
2013-08-26 22:12:46 +02:00
|
|
|
|
|
2013-08-27 18:34:49 +02:00
|
|
|
|
When REFERENCES-GRAPHS is true, it must be a list of file name/store path
|
2013-08-26 22:12:46 +02:00
|
|
|
|
pairs. In that case, the reference graph of each store path is exported in
|
2014-01-25 17:04:35 +01:00
|
|
|
|
the build environment in the corresponding file, in a simple text format.
|
|
|
|
|
|
2014-06-01 23:32:26 +02:00
|
|
|
|
When ALLOWED-REFERENCES is true, it must be a list of store items or outputs
|
|
|
|
|
that the derivation's output may refer to.
|
|
|
|
|
|
2014-01-25 17:04:35 +01:00
|
|
|
|
When LOCAL-BUILD? is true, declare that the derivation is not a good candidate
|
|
|
|
|
for offloading and should rather be built locally. This is the case for small
|
|
|
|
|
derivations where the costs of data transfers would outweigh the benefits."
|
2012-06-01 23:29:55 +02:00
|
|
|
|
(define (add-output-paths drv)
|
|
|
|
|
;; Return DRV with an actual store path for each of its output and the
|
|
|
|
|
;; corresponding environment variable.
|
|
|
|
|
(match drv
|
|
|
|
|
(($ <derivation> outputs inputs sources
|
|
|
|
|
system builder args env-vars)
|
|
|
|
|
(let* ((drv-hash (derivation-hash drv))
|
|
|
|
|
(outputs (map (match-lambda
|
2012-06-08 21:31:01 +02:00
|
|
|
|
((output-name . ($ <derivation-output>
|
2014-02-21 23:03:19 +01:00
|
|
|
|
_ algo hash rec?))
|
|
|
|
|
(let ((path (if hash
|
|
|
|
|
(fixed-output-path output-name
|
|
|
|
|
algo hash
|
|
|
|
|
rec? name)
|
|
|
|
|
(output-path output-name
|
|
|
|
|
drv-hash name))))
|
2012-06-08 21:31:01 +02:00
|
|
|
|
(cons output-name
|
|
|
|
|
(make-derivation-output path algo
|
2014-02-21 23:03:19 +01:00
|
|
|
|
hash rec?)))))
|
2012-06-08 21:31:01 +02:00
|
|
|
|
outputs)))
|
2012-06-01 23:29:55 +02:00
|
|
|
|
(make-derivation outputs inputs sources system builder args
|
|
|
|
|
(map (match-lambda
|
|
|
|
|
((name . value)
|
|
|
|
|
(cons name
|
|
|
|
|
(or (and=> (assoc-ref outputs name)
|
|
|
|
|
derivation-output-path)
|
|
|
|
|
value))))
|
2013-09-17 23:00:55 +02:00
|
|
|
|
env-vars)
|
|
|
|
|
#f)))))
|
2012-06-01 23:29:55 +02:00
|
|
|
|
|
2013-08-26 22:12:46 +02:00
|
|
|
|
(define (user+system-env-vars)
|
|
|
|
|
;; Some options are passed to the build daemon via the env. vars of
|
|
|
|
|
;; derivations (urgh!). We hide that from our API, but here is the place
|
|
|
|
|
;; where we kludgify those options.
|
2014-06-01 23:32:26 +02:00
|
|
|
|
(let ((env-vars `(,@(if local-build?
|
|
|
|
|
`(("preferLocalBuild" . "1"))
|
|
|
|
|
'())
|
|
|
|
|
,@(if allowed-references
|
|
|
|
|
`(("allowedReferences"
|
|
|
|
|
. ,(string-join allowed-references)))
|
|
|
|
|
'())
|
|
|
|
|
,@env-vars)))
|
2014-01-25 17:04:35 +01:00
|
|
|
|
(match references-graphs
|
|
|
|
|
(((file . path) ...)
|
|
|
|
|
(let ((value (map (cut string-append <> " " <>)
|
|
|
|
|
file path)))
|
|
|
|
|
;; XXX: This all breaks down if an element of FILE or PATH contains
|
|
|
|
|
;; white space.
|
|
|
|
|
`(("exportReferencesGraph" . ,(string-join value " "))
|
|
|
|
|
,@env-vars)))
|
|
|
|
|
(#f
|
|
|
|
|
env-vars))))
|
2013-08-26 22:12:46 +02:00
|
|
|
|
|
|
|
|
|
(define (env-vars-with-empty-outputs env-vars)
|
2012-06-01 23:29:55 +02:00
|
|
|
|
;; Return a variant of ENV-VARS where each OUTPUTS is associated with an
|
2012-07-01 22:55:49 +02:00
|
|
|
|
;; empty string, even outputs that do not appear in ENV-VARS.
|
2012-06-01 23:29:55 +02:00
|
|
|
|
(let ((e (map (match-lambda
|
|
|
|
|
((name . val)
|
|
|
|
|
(if (member name outputs)
|
|
|
|
|
(cons name "")
|
|
|
|
|
(cons name val))))
|
|
|
|
|
env-vars)))
|
2012-07-01 22:55:49 +02:00
|
|
|
|
(fold (lambda (output-name env-vars)
|
|
|
|
|
(if (assoc output-name env-vars)
|
|
|
|
|
env-vars
|
|
|
|
|
(append env-vars `((,output-name . "")))))
|
|
|
|
|
e
|
|
|
|
|
outputs)))
|
2012-06-01 23:29:55 +02:00
|
|
|
|
|
2013-09-17 23:00:55 +02:00
|
|
|
|
(define (set-file-name drv file)
|
|
|
|
|
;; Set FILE as the 'file-name' field of DRV.
|
|
|
|
|
(match drv
|
|
|
|
|
(($ <derivation> outputs inputs sources system builder
|
|
|
|
|
args env-vars)
|
|
|
|
|
(make-derivation outputs inputs sources system builder
|
|
|
|
|
args env-vars file))))
|
|
|
|
|
|
2012-06-01 23:29:55 +02:00
|
|
|
|
(let* ((outputs (map (lambda (name)
|
|
|
|
|
;; Return outputs with an empty path.
|
|
|
|
|
(cons name
|
2014-02-21 23:03:19 +01:00
|
|
|
|
(make-derivation-output "" hash-algo
|
|
|
|
|
hash recursive?)))
|
2012-06-01 23:29:55 +02:00
|
|
|
|
outputs))
|
|
|
|
|
(inputs (map (match-lambda
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 17:01:40 +02:00
|
|
|
|
(((? derivation? drv))
|
|
|
|
|
(make-derivation-input (derivation-file-name drv)
|
|
|
|
|
'("out")))
|
|
|
|
|
(((? derivation? drv) sub-drvs ...)
|
|
|
|
|
(make-derivation-input (derivation-file-name drv)
|
|
|
|
|
sub-drvs))
|
2012-12-10 00:44:17 +01:00
|
|
|
|
(((? direct-store-path? input))
|
2012-06-07 23:15:00 +02:00
|
|
|
|
(make-derivation-input input '("out")))
|
2012-12-10 00:44:17 +01:00
|
|
|
|
(((? direct-store-path? input) sub-drvs ...)
|
2012-06-01 23:29:55 +02:00
|
|
|
|
(make-derivation-input input sub-drvs))
|
|
|
|
|
((input . _)
|
|
|
|
|
(let ((path (add-to-store store
|
|
|
|
|
(basename input)
|
2013-01-30 16:30:49 +01:00
|
|
|
|
#t "sha256" input)))
|
2012-06-01 23:29:55 +02:00
|
|
|
|
(make-derivation-input path '()))))
|
2012-06-29 00:27:32 +02:00
|
|
|
|
(delete-duplicates inputs)))
|
2013-08-26 22:12:46 +02:00
|
|
|
|
(env-vars (env-vars-with-empty-outputs (user+system-env-vars)))
|
2012-06-01 23:29:55 +02:00
|
|
|
|
(drv-masked (make-derivation outputs
|
|
|
|
|
(filter (compose derivation-path?
|
|
|
|
|
derivation-input-path)
|
|
|
|
|
inputs)
|
|
|
|
|
(filter-map (lambda (i)
|
|
|
|
|
(let ((p (derivation-input-path i)))
|
|
|
|
|
(and (not (derivation-path? p))
|
|
|
|
|
p)))
|
|
|
|
|
inputs)
|
2013-09-17 23:00:55 +02:00
|
|
|
|
system builder args env-vars #f))
|
2012-06-01 23:29:55 +02:00
|
|
|
|
(drv (add-output-paths drv-masked)))
|
2012-06-07 23:15:00 +02:00
|
|
|
|
|
2013-09-17 23:00:55 +02:00
|
|
|
|
(let ((file (add-text-to-store store (string-append name ".drv")
|
2014-04-29 18:13:10 +02:00
|
|
|
|
(derivation->string drv)
|
2013-09-17 23:00:55 +02:00
|
|
|
|
(map derivation-input-path
|
|
|
|
|
inputs))))
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 17:01:40 +02:00
|
|
|
|
(set-file-name drv file))))
|
|
|
|
|
|
2013-11-13 00:25:57 +01:00
|
|
|
|
(define* (map-derivation store drv mapping
|
|
|
|
|
#:key (system (%current-system)))
|
|
|
|
|
"Given MAPPING, a list of pairs of derivations, return a derivation based on
|
|
|
|
|
DRV where all the 'car's of MAPPING have been replaced by its 'cdr's,
|
|
|
|
|
recursively."
|
|
|
|
|
(define (substitute str initial replacements)
|
|
|
|
|
(fold (lambda (path replacement result)
|
|
|
|
|
(string-replace-substring result path
|
|
|
|
|
replacement))
|
|
|
|
|
str
|
|
|
|
|
initial replacements))
|
|
|
|
|
|
|
|
|
|
(define (substitute-file file initial replacements)
|
|
|
|
|
(define contents
|
|
|
|
|
(with-fluids ((%default-port-encoding #f))
|
|
|
|
|
(call-with-input-file file get-string-all)))
|
|
|
|
|
|
|
|
|
|
(let ((updated (substitute contents initial replacements)))
|
|
|
|
|
(if (string=? updated contents)
|
|
|
|
|
file
|
|
|
|
|
;; XXX: permissions aren't preserved.
|
|
|
|
|
(add-text-to-store store (store-path-package-name file)
|
|
|
|
|
updated))))
|
|
|
|
|
|
|
|
|
|
(define input->output-paths
|
|
|
|
|
(match-lambda
|
2013-11-13 11:22:07 +01:00
|
|
|
|
(((? derivation? drv))
|
2013-11-13 00:25:57 +01:00
|
|
|
|
(list (derivation->output-path drv)))
|
2013-11-13 11:22:07 +01:00
|
|
|
|
(((? derivation? drv) sub-drvs ...)
|
2013-11-13 00:25:57 +01:00
|
|
|
|
(map (cut derivation->output-path drv <>)
|
2013-11-13 11:22:07 +01:00
|
|
|
|
sub-drvs))
|
|
|
|
|
((file)
|
|
|
|
|
(list file))))
|
2013-11-13 00:25:57 +01:00
|
|
|
|
|
|
|
|
|
(let ((mapping (fold (lambda (pair result)
|
|
|
|
|
(match pair
|
2013-11-13 11:22:07 +01:00
|
|
|
|
(((? derivation? orig) . replacement)
|
2013-11-13 00:25:57 +01:00
|
|
|
|
(vhash-cons (derivation-file-name orig)
|
2013-11-13 11:22:07 +01:00
|
|
|
|
replacement result))
|
|
|
|
|
((file . replacement)
|
|
|
|
|
(vhash-cons file replacement result))))
|
2013-11-13 00:25:57 +01:00
|
|
|
|
vlist-null
|
|
|
|
|
mapping)))
|
|
|
|
|
(define rewritten-input
|
|
|
|
|
;; Rewrite the given input according to MAPPING, and return an input
|
|
|
|
|
;; in the format used in 'derivation' calls.
|
|
|
|
|
(memoize
|
|
|
|
|
(lambda (input loop)
|
|
|
|
|
(match input
|
|
|
|
|
(($ <derivation-input> path (sub-drvs ...))
|
|
|
|
|
(match (vhash-assoc path mapping)
|
2013-11-13 11:22:07 +01:00
|
|
|
|
((_ . (? derivation? replacement))
|
2013-11-13 00:25:57 +01:00
|
|
|
|
(cons replacement sub-drvs))
|
2013-11-13 11:22:07 +01:00
|
|
|
|
((_ . replacement)
|
|
|
|
|
(list replacement))
|
2013-11-13 00:25:57 +01:00
|
|
|
|
(#f
|
|
|
|
|
(let* ((drv (loop (call-with-input-file path read-derivation))))
|
|
|
|
|
(cons drv sub-drvs)))))))))
|
|
|
|
|
|
|
|
|
|
(let loop ((drv drv))
|
|
|
|
|
(let* ((inputs (map (cut rewritten-input <> loop)
|
|
|
|
|
(derivation-inputs drv)))
|
|
|
|
|
(initial (append-map derivation-input-output-paths
|
|
|
|
|
(derivation-inputs drv)))
|
|
|
|
|
(replacements (append-map input->output-paths inputs))
|
|
|
|
|
|
|
|
|
|
;; Sources typically refer to the output directories of the
|
|
|
|
|
;; original inputs, INITIAL. Rewrite them by substituting
|
|
|
|
|
;; REPLACEMENTS.
|
2013-11-13 11:22:07 +01:00
|
|
|
|
(sources (map (lambda (source)
|
|
|
|
|
(match (vhash-assoc source mapping)
|
|
|
|
|
((_ . replacement)
|
|
|
|
|
replacement)
|
|
|
|
|
(#f
|
|
|
|
|
(substitute-file source
|
|
|
|
|
initial replacements))))
|
2013-11-13 00:25:57 +01:00
|
|
|
|
(derivation-sources drv)))
|
|
|
|
|
|
|
|
|
|
;; Now augment the lists of initials and replacements.
|
|
|
|
|
(initial (append (derivation-sources drv) initial))
|
|
|
|
|
(replacements (append sources replacements))
|
|
|
|
|
(name (store-path-package-name
|
|
|
|
|
(string-drop-right (derivation-file-name drv)
|
|
|
|
|
4))))
|
|
|
|
|
(derivation store name
|
|
|
|
|
(substitute (derivation-builder drv)
|
|
|
|
|
initial replacements)
|
|
|
|
|
(map (cut substitute <> initial replacements)
|
|
|
|
|
(derivation-builder-arguments drv))
|
|
|
|
|
#:system system
|
|
|
|
|
#:env-vars (map (match-lambda
|
|
|
|
|
((var . value)
|
|
|
|
|
`(,var
|
|
|
|
|
. ,(substitute value initial
|
|
|
|
|
replacements))))
|
|
|
|
|
(derivation-builder-environment-vars drv))
|
|
|
|
|
#:inputs (append (map list sources) inputs)
|
|
|
|
|
#:outputs (map car (derivation-outputs drv))
|
|
|
|
|
#:hash (match (derivation-outputs drv)
|
|
|
|
|
((($ <derivation-output> _ algo hash))
|
|
|
|
|
hash)
|
|
|
|
|
(_ #f))
|
|
|
|
|
#:hash-algo (match (derivation-outputs drv)
|
|
|
|
|
((($ <derivation-output> _ algo hash))
|
|
|
|
|
algo)
|
|
|
|
|
(_ #f)))))))
|
|
|
|
|
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 17:01:40 +02:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; Store compatibility layer.
|
|
|
|
|
;;;
|
|
|
|
|
|
|
|
|
|
(define (build-derivations store derivations)
|
|
|
|
|
"Build DERIVATIONS, a list of <derivation> objects or .drv file names."
|
|
|
|
|
(let ((build (@ (guix store) build-derivations)))
|
|
|
|
|
(build store (map (match-lambda
|
|
|
|
|
((? string? file) file)
|
|
|
|
|
((and drv ($ <derivation>))
|
|
|
|
|
(derivation-file-name drv)))
|
|
|
|
|
derivations))))
|
2012-06-08 21:31:01 +02:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; Guile-based builders.
|
|
|
|
|
;;;
|
|
|
|
|
|
|
|
|
|
(define %guile-for-build
|
|
|
|
|
;; The derivation of the Guile to be used within the build environment,
|
|
|
|
|
;; when using `build-expression->derivation'.
|
2012-10-25 18:03:48 +02:00
|
|
|
|
(make-parameter #f))
|
2012-06-08 21:31:01 +02:00
|
|
|
|
|
2012-10-22 23:30:35 +02:00
|
|
|
|
(define (parent-directories file-name)
|
|
|
|
|
"Return the list of parent dirs of FILE-NAME, in the order in which an
|
|
|
|
|
`mkdir -p' implementation would make them."
|
|
|
|
|
(let ((not-slash (char-set-complement (char-set #\/))))
|
|
|
|
|
(reverse
|
|
|
|
|
(fold (lambda (dir result)
|
|
|
|
|
(match result
|
|
|
|
|
(()
|
|
|
|
|
(list dir))
|
|
|
|
|
((prev _ ...)
|
|
|
|
|
(cons (string-append prev "/" dir)
|
|
|
|
|
result))))
|
|
|
|
|
'()
|
|
|
|
|
(remove (cut string=? <> ".")
|
|
|
|
|
(string-tokenize (dirname file-name) not-slash))))))
|
|
|
|
|
|
2012-06-11 23:12:55 +02:00
|
|
|
|
(define* (imported-files store files
|
2012-10-25 18:03:48 +02:00
|
|
|
|
#:key (name "file-import")
|
|
|
|
|
(system (%current-system))
|
|
|
|
|
(guile (%guile-for-build)))
|
2012-06-11 23:12:55 +02:00
|
|
|
|
"Return a derivation that imports FILES into STORE. FILES must be a list
|
|
|
|
|
of (FINAL-PATH . FILE-NAME) pairs; each FILE-NAME is read from the file
|
|
|
|
|
system, imported, and appears under FINAL-PATH in the resulting store path."
|
|
|
|
|
(let* ((files (map (match-lambda
|
|
|
|
|
((final-path . file-name)
|
2012-06-13 17:21:27 +02:00
|
|
|
|
(list final-path
|
2013-01-30 16:30:49 +01:00
|
|
|
|
(add-to-store store (basename final-path) #f
|
2012-06-11 23:12:55 +02:00
|
|
|
|
"sha256" file-name))))
|
|
|
|
|
files))
|
|
|
|
|
(builder
|
|
|
|
|
`(begin
|
|
|
|
|
(mkdir %output) (chdir %output)
|
|
|
|
|
,@(append-map (match-lambda
|
2012-06-13 17:21:27 +02:00
|
|
|
|
((final-path store-path)
|
2012-10-22 23:30:35 +02:00
|
|
|
|
(append (match (parent-directories final-path)
|
2012-06-11 23:12:55 +02:00
|
|
|
|
(() '())
|
|
|
|
|
((head ... tail)
|
|
|
|
|
(append (map (lambda (d)
|
|
|
|
|
`(false-if-exception
|
|
|
|
|
(mkdir ,d)))
|
|
|
|
|
head)
|
2012-06-12 23:30:00 +02:00
|
|
|
|
`((or (file-exists? ,tail)
|
|
|
|
|
(mkdir ,tail))))))
|
2012-06-11 23:12:55 +02:00
|
|
|
|
`((symlink ,store-path ,final-path)))))
|
|
|
|
|
files))))
|
derivations: Use more keyword parameters for 'build-expression->derivation'.
* guix/derivations.scm (build-expression->derivation): Turn 'system' and
'inputs' into keyword parameters.
Adjust callers accordingly.
* gnu/system/linux.scm, gnu/system/vm.scm, guix/build-system/cmake.scm,
guix/build-system/gnu.scm, guix/build-system/perl.scm,
guix/build-system/python.scm, guix/build-system/trivial.scm,
guix/download.scm, guix/packages.scm, guix/profiles.scm,
guix/scripts/pull.scm, tests/derivations.scm, tests/guix-build.sh,
tests/monads.scm, tests/store.scm, tests/union.scm: Adjust users of
'build-expression->derivation' and 'derivation-expression'
accordingly.
* doc/guix.texi (Derivations): Adjust 'build-expression->derivation'
documentation accordingly.
(The Store Monad): Likewise for 'derivation-expression'.
2013-12-04 16:07:36 +01:00
|
|
|
|
(build-expression->derivation store name builder
|
|
|
|
|
#:system system
|
|
|
|
|
#:inputs files
|
2014-01-25 17:22:53 +01:00
|
|
|
|
#:guile-for-build guile
|
|
|
|
|
#:local-build? #t)))
|
2012-06-11 23:12:55 +02:00
|
|
|
|
|
2012-06-12 00:18:14 +02:00
|
|
|
|
(define* (imported-modules store modules
|
|
|
|
|
#:key (name "module-import")
|
2012-10-25 18:03:48 +02:00
|
|
|
|
(system (%current-system))
|
2013-02-20 21:08:09 +01:00
|
|
|
|
(guile (%guile-for-build))
|
|
|
|
|
(module-path %load-path))
|
2012-06-12 00:18:14 +02:00
|
|
|
|
"Return a derivation that contains the source files of MODULES, a list of
|
2013-02-20 21:08:09 +01:00
|
|
|
|
module names such as `(ice-9 q)'. All of MODULES must be in the MODULE-PATH
|
2012-06-12 00:18:14 +02:00
|
|
|
|
search path."
|
|
|
|
|
;; TODO: Determine the closure of MODULES, build the `.go' files,
|
|
|
|
|
;; canonicalize the source files through read/write, etc.
|
|
|
|
|
(let ((files (map (lambda (m)
|
|
|
|
|
(let ((f (string-append
|
|
|
|
|
(string-join (map symbol->string m) "/")
|
|
|
|
|
".scm")))
|
2013-02-20 21:08:09 +01:00
|
|
|
|
(cons f (search-path module-path f))))
|
2012-06-12 00:18:14 +02:00
|
|
|
|
modules)))
|
2012-10-25 18:03:48 +02:00
|
|
|
|
(imported-files store files #:name name #:system system
|
|
|
|
|
#:guile guile)))
|
2012-06-12 00:18:14 +02:00
|
|
|
|
|
2012-10-22 23:30:35 +02:00
|
|
|
|
(define* (compiled-modules store modules
|
|
|
|
|
#:key (name "module-import-compiled")
|
2012-10-25 18:03:48 +02:00
|
|
|
|
(system (%current-system))
|
2013-02-20 21:08:09 +01:00
|
|
|
|
(guile (%guile-for-build))
|
|
|
|
|
(module-path %load-path))
|
2012-10-22 23:30:35 +02:00
|
|
|
|
"Return a derivation that builds a tree containing the `.go' files
|
|
|
|
|
corresponding to MODULES. All the MODULES are built in a context where
|
|
|
|
|
they can refer to each other."
|
|
|
|
|
(let* ((module-drv (imported-modules store modules
|
2012-10-25 18:03:48 +02:00
|
|
|
|
#:system system
|
2013-02-20 21:08:09 +01:00
|
|
|
|
#:guile guile
|
|
|
|
|
#:module-path module-path))
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 17:01:40 +02:00
|
|
|
|
(module-dir (derivation->output-path module-drv))
|
2012-10-22 23:30:35 +02:00
|
|
|
|
(files (map (lambda (m)
|
|
|
|
|
(let ((f (string-join (map symbol->string m)
|
|
|
|
|
"/")))
|
|
|
|
|
(cons (string-append f ".go")
|
|
|
|
|
(string-append module-dir "/" f ".scm"))))
|
|
|
|
|
modules)))
|
|
|
|
|
(define builder
|
|
|
|
|
`(begin
|
|
|
|
|
(use-modules (system base compile))
|
|
|
|
|
(let ((out (assoc-ref %outputs "out")))
|
|
|
|
|
(mkdir out)
|
|
|
|
|
(chdir out))
|
|
|
|
|
|
|
|
|
|
(set! %load-path
|
|
|
|
|
(cons ,module-dir %load-path))
|
|
|
|
|
|
|
|
|
|
,@(map (match-lambda
|
|
|
|
|
((output . input)
|
|
|
|
|
(let ((make-parent-dirs (map (lambda (dir)
|
|
|
|
|
`(unless (file-exists? ,dir)
|
|
|
|
|
(mkdir ,dir)))
|
|
|
|
|
(parent-directories output))))
|
|
|
|
|
`(begin
|
|
|
|
|
,@make-parent-dirs
|
|
|
|
|
(compile-file ,input
|
|
|
|
|
#:output-file ,output
|
|
|
|
|
#:opts %auto-compilation-options)))))
|
|
|
|
|
files)))
|
|
|
|
|
|
derivations: Use more keyword parameters for 'build-expression->derivation'.
* guix/derivations.scm (build-expression->derivation): Turn 'system' and
'inputs' into keyword parameters.
Adjust callers accordingly.
* gnu/system/linux.scm, gnu/system/vm.scm, guix/build-system/cmake.scm,
guix/build-system/gnu.scm, guix/build-system/perl.scm,
guix/build-system/python.scm, guix/build-system/trivial.scm,
guix/download.scm, guix/packages.scm, guix/profiles.scm,
guix/scripts/pull.scm, tests/derivations.scm, tests/guix-build.sh,
tests/monads.scm, tests/store.scm, tests/union.scm: Adjust users of
'build-expression->derivation' and 'derivation-expression'
accordingly.
* doc/guix.texi (Derivations): Adjust 'build-expression->derivation'
documentation accordingly.
(The Store Monad): Likewise for 'derivation-expression'.
2013-12-04 16:07:36 +01:00
|
|
|
|
(build-expression->derivation store name builder
|
|
|
|
|
#:inputs `(("modules" ,module-drv))
|
|
|
|
|
#:system system
|
2014-01-25 17:22:53 +01:00
|
|
|
|
#:guile-for-build guile
|
|
|
|
|
#:local-build? #t)))
|
2012-06-12 00:18:14 +02:00
|
|
|
|
|
2014-10-12 22:32:38 +02:00
|
|
|
|
(define* (graft-derivation store name drv replacements
|
|
|
|
|
#:key (guile (%guile-for-build)))
|
2014-10-07 23:23:09 +02:00
|
|
|
|
"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."
|
|
|
|
|
;; XXX: Someday rewrite using gexps.
|
|
|
|
|
(define mapping
|
|
|
|
|
;; List of store item pairs.
|
|
|
|
|
(map (match-lambda
|
|
|
|
|
(((source source-outputs ...) . (target target-outputs ...))
|
|
|
|
|
(cons (if (derivation? source)
|
|
|
|
|
(apply derivation->output-path source source-outputs)
|
|
|
|
|
source)
|
|
|
|
|
(if (derivation? target)
|
|
|
|
|
(apply derivation->output-path target target-outputs)
|
|
|
|
|
target))))
|
|
|
|
|
replacements))
|
|
|
|
|
|
|
|
|
|
(define outputs
|
|
|
|
|
(match (derivation-outputs drv)
|
|
|
|
|
(((names . outputs) ...)
|
|
|
|
|
(map derivation-output-path outputs))))
|
|
|
|
|
|
|
|
|
|
(define output-names
|
|
|
|
|
(match (derivation-outputs drv)
|
|
|
|
|
(((names . outputs) ...)
|
|
|
|
|
names)))
|
|
|
|
|
|
|
|
|
|
(define build
|
|
|
|
|
`(begin
|
|
|
|
|
(use-modules (guix build graft)
|
|
|
|
|
(guix build utils)
|
|
|
|
|
(ice-9 match))
|
|
|
|
|
|
|
|
|
|
(let ((mapping ',mapping))
|
|
|
|
|
(for-each (lambda (input output)
|
|
|
|
|
(format #t "rewriting '~a' to '~a'...~%" input output)
|
|
|
|
|
(rewrite-directory input output
|
|
|
|
|
`((,input . ,output)
|
|
|
|
|
,@mapping)))
|
|
|
|
|
',outputs
|
|
|
|
|
(match %outputs
|
|
|
|
|
(((names . files) ...)
|
|
|
|
|
files))))))
|
|
|
|
|
|
|
|
|
|
(define add-label
|
|
|
|
|
(cut cons "x" <>))
|
|
|
|
|
|
|
|
|
|
(match replacements
|
|
|
|
|
(((sources . targets) ...)
|
|
|
|
|
(build-expression->derivation store name build
|
2014-10-12 22:32:38 +02:00
|
|
|
|
#:guile-for-build guile
|
2014-10-07 23:23:09 +02:00
|
|
|
|
#:modules '((guix build graft)
|
|
|
|
|
(guix build utils))
|
|
|
|
|
#:inputs `(("original" ,drv)
|
|
|
|
|
,@(append (map add-label sources)
|
|
|
|
|
(map add-label targets)))
|
|
|
|
|
#:outputs output-names
|
|
|
|
|
#:local-build? #t))))
|
|
|
|
|
|
derivations: Use more keyword parameters for 'build-expression->derivation'.
* guix/derivations.scm (build-expression->derivation): Turn 'system' and
'inputs' into keyword parameters.
Adjust callers accordingly.
* gnu/system/linux.scm, gnu/system/vm.scm, guix/build-system/cmake.scm,
guix/build-system/gnu.scm, guix/build-system/perl.scm,
guix/build-system/python.scm, guix/build-system/trivial.scm,
guix/download.scm, guix/packages.scm, guix/profiles.scm,
guix/scripts/pull.scm, tests/derivations.scm, tests/guix-build.sh,
tests/monads.scm, tests/store.scm, tests/union.scm: Adjust users of
'build-expression->derivation' and 'derivation-expression'
accordingly.
* doc/guix.texi (Derivations): Adjust 'build-expression->derivation'
documentation accordingly.
(The Store Monad): Likewise for 'derivation-expression'.
2013-12-04 16:07:36 +01:00
|
|
|
|
(define* (build-expression->derivation store name exp
|
|
|
|
|
#:key
|
|
|
|
|
(system (%current-system))
|
|
|
|
|
(inputs '())
|
|
|
|
|
(outputs '("out"))
|
2014-02-21 23:03:19 +01:00
|
|
|
|
hash hash-algo recursive?
|
2012-09-01 11:33:20 +02:00
|
|
|
|
(env-vars '())
|
2012-09-01 11:45:52 +02:00
|
|
|
|
(modules '())
|
2013-08-26 22:19:21 +02:00
|
|
|
|
guile-for-build
|
2014-01-25 17:04:35 +01:00
|
|
|
|
references-graphs
|
2014-06-06 17:07:26 +02:00
|
|
|
|
allowed-references
|
2014-01-25 17:04:35 +01:00
|
|
|
|
local-build?)
|
2013-01-16 23:09:06 +01:00
|
|
|
|
"Return a derivation that executes Scheme expression EXP as a builder
|
|
|
|
|
for derivation NAME. INPUTS must be a list of (NAME DRV-PATH SUB-DRV)
|
|
|
|
|
tuples; when SUB-DRV is omitted, \"out\" is assumed. MODULES is a list
|
|
|
|
|
of names of Guile modules from the current search path to be copied in
|
|
|
|
|
the store, compiled, and made available in the load path during the
|
|
|
|
|
execution of EXP.
|
|
|
|
|
|
|
|
|
|
EXP is evaluated in an environment where %OUTPUT is bound to the main
|
|
|
|
|
output path, %OUTPUTS is bound to a list of output/path pairs, and where
|
|
|
|
|
%BUILD-INPUTS is bound to an alist of string/output-path pairs made from
|
|
|
|
|
INPUTS. Optionally, ENV-VARS is a list of string pairs specifying the
|
|
|
|
|
name and value of environment variables visible to the builder. The
|
|
|
|
|
builder terminates by passing the result of EXP to `exit'; thus, when
|
|
|
|
|
EXP returns #f, the build is considered to have failed.
|
2012-09-01 11:45:52 +02:00
|
|
|
|
|
|
|
|
|
EXP is built using GUILE-FOR-BUILD (a derivation). When GUILE-FOR-BUILD is
|
2013-08-26 22:19:21 +02:00
|
|
|
|
omitted or is #f, the value of the `%guile-for-build' fluid is used instead.
|
|
|
|
|
|
2014-06-06 17:07:26 +02:00
|
|
|
|
See the `derivation' procedure for the meaning of REFERENCES-GRAPHS,
|
|
|
|
|
ALLOWED-REFERENCES, and LOCAL-BUILD?."
|
2012-10-25 18:03:48 +02:00
|
|
|
|
(define guile-drv
|
|
|
|
|
(or guile-for-build (%guile-for-build)))
|
|
|
|
|
|
2012-06-08 21:31:01 +02:00
|
|
|
|
(define guile
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 17:01:40 +02:00
|
|
|
|
(string-append (derivation->output-path guile-drv)
|
2012-06-08 21:31:01 +02:00
|
|
|
|
"/bin/guile"))
|
|
|
|
|
|
2012-06-17 16:43:40 +02:00
|
|
|
|
(define module-form?
|
|
|
|
|
(match-lambda
|
2013-08-26 22:11:04 +02:00
|
|
|
|
(((or 'define-module 'use-modules) _ ...) #t)
|
|
|
|
|
(_ #f)))
|
2012-06-17 16:43:40 +02:00
|
|
|
|
|
2012-11-09 00:07:10 +01:00
|
|
|
|
(define source-path
|
|
|
|
|
;; When passed an input that is a source, return its path; otherwise
|
|
|
|
|
;; return #f.
|
|
|
|
|
(match-lambda
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 17:01:40 +02:00
|
|
|
|
((_ (? derivation?) _ ...)
|
|
|
|
|
#f)
|
2012-11-09 00:07:10 +01:00
|
|
|
|
((_ path _ ...)
|
|
|
|
|
(and (not (derivation-path? path))
|
|
|
|
|
path))))
|
|
|
|
|
|
2012-06-08 21:31:01 +02:00
|
|
|
|
(let* ((prologue `(begin
|
2012-06-17 16:43:40 +02:00
|
|
|
|
,@(match exp
|
|
|
|
|
((_ ...)
|
|
|
|
|
;; Module forms must appear at the top-level so
|
|
|
|
|
;; that any macros they export can be expanded.
|
|
|
|
|
(filter module-form? exp))
|
|
|
|
|
(_ `(,exp)))
|
|
|
|
|
|
2012-06-08 21:31:01 +02:00
|
|
|
|
(define %output (getenv "out"))
|
2012-06-09 23:16:55 +02:00
|
|
|
|
(define %outputs
|
|
|
|
|
(map (lambda (o)
|
|
|
|
|
(cons o (getenv o)))
|
|
|
|
|
',outputs))
|
2012-06-08 21:31:01 +02:00
|
|
|
|
(define %build-inputs
|
|
|
|
|
',(map (match-lambda
|
2012-06-13 17:21:27 +02:00
|
|
|
|
((name drv . rest)
|
|
|
|
|
(let ((sub (match rest
|
|
|
|
|
(() "out")
|
|
|
|
|
((x) x))))
|
|
|
|
|
(cons name
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 17:01:40 +02:00
|
|
|
|
(cond
|
|
|
|
|
((derivation? drv)
|
|
|
|
|
(derivation->output-path drv sub))
|
|
|
|
|
((derivation-path? drv)
|
|
|
|
|
(derivation-path->output-path drv
|
|
|
|
|
sub))
|
|
|
|
|
(else drv))))))
|
2012-07-07 22:38:08 +02:00
|
|
|
|
inputs))
|
|
|
|
|
|
2012-10-22 23:30:35 +02:00
|
|
|
|
,@(if (null? modules)
|
|
|
|
|
'()
|
|
|
|
|
;; Remove our own settings.
|
|
|
|
|
'((unsetenv "GUILE_LOAD_COMPILED_PATH")))
|
|
|
|
|
|
2012-07-07 22:38:08 +02:00
|
|
|
|
;; Guile sets it, but remove it to avoid conflicts when
|
|
|
|
|
;; building Guile-using packages.
|
|
|
|
|
(unsetenv "LD_LIBRARY_PATH")))
|
2012-06-08 21:31:01 +02:00
|
|
|
|
(builder (add-text-to-store store
|
|
|
|
|
(string-append name "-guile-builder")
|
2013-03-16 17:22:20 +01:00
|
|
|
|
|
|
|
|
|
;; Explicitly use UTF-8 for determinism,
|
|
|
|
|
;; and also because UTF-8 output is faster.
|
|
|
|
|
(with-fluids ((%default-port-encoding
|
|
|
|
|
"UTF-8"))
|
|
|
|
|
(call-with-output-string
|
|
|
|
|
(lambda (port)
|
|
|
|
|
(write prologue port)
|
|
|
|
|
(write
|
|
|
|
|
`(exit
|
|
|
|
|
,(match exp
|
|
|
|
|
((_ ...)
|
|
|
|
|
(remove module-form? exp))
|
|
|
|
|
(_ `(,exp))))
|
|
|
|
|
port))))
|
2012-11-09 00:07:10 +01:00
|
|
|
|
|
|
|
|
|
;; The references don't really matter
|
|
|
|
|
;; since the builder is always used in
|
|
|
|
|
;; conjunction with the drv that needs
|
|
|
|
|
;; it. For clarity, we add references
|
|
|
|
|
;; to the subset of INPUTS that are
|
|
|
|
|
;; sources, avoiding references to other
|
|
|
|
|
;; .drv; otherwise, BUILDER's hash would
|
|
|
|
|
;; depend on those, even if they are
|
|
|
|
|
;; fixed-output.
|
|
|
|
|
(filter-map source-path inputs)))
|
|
|
|
|
|
2012-10-22 23:30:35 +02:00
|
|
|
|
(mod-drv (and (pair? modules)
|
2012-10-25 23:14:27 +02:00
|
|
|
|
(imported-modules store modules
|
|
|
|
|
#:guile guile-drv
|
|
|
|
|
#:system system)))
|
2012-06-12 00:18:14 +02:00
|
|
|
|
(mod-dir (and mod-drv
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 17:01:40 +02:00
|
|
|
|
(derivation->output-path mod-drv)))
|
2012-10-22 23:30:35 +02:00
|
|
|
|
(go-drv (and (pair? modules)
|
2012-10-25 23:14:27 +02:00
|
|
|
|
(compiled-modules store modules
|
|
|
|
|
#:guile guile-drv
|
|
|
|
|
#:system system)))
|
2012-10-22 23:30:35 +02:00
|
|
|
|
(go-dir (and go-drv
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 17:01:40 +02:00
|
|
|
|
(derivation->output-path go-drv))))
|
2013-08-26 22:11:04 +02:00
|
|
|
|
(derivation store name guile
|
2012-06-12 00:18:14 +02:00
|
|
|
|
`("--no-auto-compile"
|
|
|
|
|
,@(if mod-dir `("-L" ,mod-dir) '())
|
|
|
|
|
,builder)
|
2012-10-22 23:30:35 +02:00
|
|
|
|
|
2013-08-26 22:11:04 +02:00
|
|
|
|
#:system system
|
|
|
|
|
|
|
|
|
|
#:inputs `((,(or guile-for-build (%guile-for-build)))
|
|
|
|
|
(,builder)
|
|
|
|
|
,@(map cdr inputs)
|
|
|
|
|
,@(if mod-drv `((,mod-drv) (,go-drv)) '()))
|
|
|
|
|
|
2012-10-22 23:30:35 +02:00
|
|
|
|
;; When MODULES is non-empty, shamelessly clobber
|
|
|
|
|
;; $GUILE_LOAD_COMPILED_PATH.
|
2013-08-26 22:11:04 +02:00
|
|
|
|
#:env-vars (if go-dir
|
|
|
|
|
`(("GUILE_LOAD_COMPILED_PATH" . ,go-dir)
|
|
|
|
|
,@(alist-delete "GUILE_LOAD_COMPILED_PATH"
|
|
|
|
|
env-vars))
|
|
|
|
|
env-vars)
|
|
|
|
|
|
2012-06-09 23:16:55 +02:00
|
|
|
|
#:hash hash #:hash-algo hash-algo
|
2014-02-21 23:03:19 +01:00
|
|
|
|
#:recursive? recursive?
|
2013-08-26 22:19:21 +02:00
|
|
|
|
#:outputs outputs
|
2014-01-25 17:04:35 +01:00
|
|
|
|
#:references-graphs references-graphs
|
2014-06-06 17:07:26 +02:00
|
|
|
|
#:allowed-references allowed-references
|
2014-01-25 17:04:35 +01:00
|
|
|
|
#:local-build? local-build?)))
|