build-system: Rewrite using gexps.

* guix/packages.scm (expand-input): Remove 'store', 'system', and
  'cross-system' parameters; add #:native?.  Rewrite to return
  name/gexp-input tuples.
  (bag->derivation): Adjust accordingly.  Lower (bag-build bag).
  (bag->cross-derivation): Ditto.  Instead of #:native-drvs and
  #:target-drvs, pass #:build-inputs, #:host-inputs, and #:target-inputs.
  (%derivation-cache): Remove.
* gnu/packages/bootstrap.scm (raw-build): Turn into a monadic procedure.
* gnu/packages/commencement.scm (glibc-final)[arguments]: Use
  'gexp-input' for the #:allowed-references argument.
* guix/build-system/cmake.scm (cmake-build): Remove 'store' parameter.
  Switch to the use of gexps and 'gexp->derivation'.
  (lower): Remove #:source from 'private-keywords'.
* guix/build-system/glib-or-gtk.scm (glib-or-gtk-build, lower):
  Likewise.
* guix/build-system/font.scm (font-build): Likewise.
* guix/build-system/gnu.scm (gnu-build): Likewise, and remove
  'canonicalize-reference'.
  (gnu-cross-build): Likewise, and expect #:build-inputs, #:host-inputs,
  and #:target-inputs instead of #:native-drvs and #:target-drvs.
  (lower): Likewise.
* guix/build-system/perl.scm (perl-build, lower): Likewise.
* guix/build-system/python.scm (python-build, lower): Likewise.
* guix/build-system/ruby.scm (ruby-build, lower): Likewise.
* guix/build-system/waf.scm (waf-build, lower): Likewise.
* guix/build-system/trivial.scm (guile-for-build): Remove.
  (trivial-build): Remove 'store' parameter, change to gexps.
  (trivial-cross-build): Ditto, and change to #:build-inputs & co.
* guix/build-system/cargo.scm (cargo-build): Change to 'gexp->derivation'.
* guix/build-system/copy.scm (copy-build): Likewise.
* guix/build-system/dune.scm (dune-build): Likewise.
* guix/build-system/guile.scm (guile-build, guile-cross-build):
  Likewise.
* guix/build-system/meson.scm (meson-build): Likewise.
* guix/build-system/ocaml.scm (ocaml-build): Likewise.
* guix/build-system/scons.scm (scons-build): Likewise.
* guix/build-system/texlive.scm (texlive-build): Likewise.
* guix/build-system/android-ndk.scm (android-ndk-build): Likewise.
* guix/build-system/ant.scm (ant-build): Likewise.
* guix/build-system/asdf.scm (asdf-build/source, asdf-build): Likewise.
* guix/build-system/chicken.scm (chicken-build): Likewise.
* guix/build-system/clojure.scm (clojure-build): Likewise.
(source->output-path, maybe-guile->guile): Remove.
* guix/build-system/dub.scm (dub-build): Likewise.
* guix/build-system/emacs.scm (emacs-build): Likewise.
* guix/build-system/go.scm (go-build): Likewise.
* guix/build-system/haskell.scm (haskell-build): Likewise.
* guix/build-system/julia.scm (julia-build): Likewise.
* guix/build-system/linux-module.scm (linux-module-build)
(linux-module-build-cross): Likewise.
* guix/build-system/maven.scm (maven-build): Likewise.
* guix/build-system/minify.scm (minify-build): Likewise.
* guix/build-system/node.scm (node-build): Likewise.
* guix/build-system/qt.scm (qt-build, qt-cross-build): Likewise.
* guix/build-system/r.scm (r-build): Likewise.
* guix/build-system/rakudo.scm (rakudo-build): Likewise.
* guix/build-system/renpy.scm (renpy-build): Likewise.
* tests/builders.scm ("gnu-build"): Call 'store-lower' on 'gnu-build'.
  Pass #:source parameter.
* tests/packages.scm ("search paths"): Use 'abort-to-prompt' instead of
  a normal return from the 'build' method.
  ("package->bag, sensitivity to %current-target-system"): Change 'build'
  to match the new build system signature.

squash! build-system: Rewrite using gexps.

squash! build-system: Rewrite using gexps.
This commit is contained in:
Ludovic Courtès 2015-03-28 19:26:39 +01:00
parent a76b6f8120
commit 7d873f194c
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
43 changed files with 1511 additions and 2130 deletions

View File

@ -119,6 +119,7 @@
(eval . (put 'with-extensions 'scheme-indent-function 1))
(eval . (put 'with-parameters 'scheme-indent-function 1))
(eval . (put 'let-system 'scheme-indent-function 1))
(eval . (put 'with-build-variables 'scheme-indent-function 2))
(eval . (put 'with-database 'scheme-indent-function 2))
(eval . (put 'call-with-database 'scheme-indent-function 1))

View File

@ -32,11 +32,13 @@
#:use-module (guix build-system gnu)
#:use-module (guix build-system trivial)
#:use-module ((guix store)
#:select (run-with-store add-to-store add-text-to-store))
#:select (%store-monad interned-file text-file store-lift))
#:use-module ((guix derivations)
#:select (derivation derivation-input derivation->output-path))
#:use-module ((guix utils) #:select (gnu-triplet->nix-system))
#:select (raw-derivation derivation-input derivation->output-path))
#:use-module (guix utils)
#:use-module ((guix build utils) #:select (elf-file?))
#:use-module ((guix gexp) #:select (lower-object))
#:use-module (guix monads)
#:use-module (guix memoization)
#:use-module (guix i18n)
#:use-module (srfi srfi-1)
@ -376,59 +378,58 @@ or false to signal an error."
%bootstrap-base-urls))
(sha256 (bootstrap-guile-hash system))))
(define (download-bootstrap-guile store system)
(define (download-bootstrap-guile system)
"Return a derivation that downloads the bootstrap Guile tarball for SYSTEM."
(let* ((path (bootstrap-guile-url-path system))
(base (basename path))
(urls (map (cut string-append <> path) %bootstrap-base-urls)))
(run-with-store store
(url-fetch urls 'sha256 (bootstrap-guile-hash system)
#:system system))))
(url-fetch urls 'sha256 (bootstrap-guile-hash system)
#:system system)))
(define* (raw-build store name inputs
(define* (raw-build name inputs
#:key outputs system search-paths
#:allow-other-keys)
(define (->store file)
(run-with-store store
(lower-object (bootstrap-executable file system)
system)))
(lower-object (bootstrap-executable file system)
system))
(let* ((tar (->store "tar"))
(xz (->store "xz"))
(mkdir (->store "mkdir"))
(bash (->store "bash"))
(guile (download-bootstrap-guile store system))
;; The following code, run by the bootstrap guile after it is
;; unpacked, creates a wrapper for itself to set its load path.
;; This replaces the previous non-portable method based on
;; reading the /proc/self/exe symlink.
(make-guile-wrapper
'(begin
(use-modules (ice-9 match))
(match (command-line)
((_ out bash)
(let ((bin-dir (string-append out "/bin"))
(guile (string-append out "/bin/guile"))
(guile-real (string-append out "/bin/.guile-real"))
;; We must avoid using a bare dollar sign in this code,
;; because it would be interpreted by the shell.
(dollar (string (integer->char 36))))
(chmod bin-dir #o755)
(rename-file guile guile-real)
(call-with-output-file guile
(lambda (p)
(format p "\
(define (make-guile-wrapper bash guile-real)
;; The following code, run by the bootstrap guile after it is unpacked,
;; creates a wrapper for itself to set its load path. This replaces the
;; previous non-portable method based on reading the /proc/self/exe
;; symlink.
'(begin
(use-modules (ice-9 match))
(match (command-line)
((_ out bash)
(let ((bin-dir (string-append out "/bin"))
(guile (string-append out "/bin/guile"))
(guile-real (string-append out "/bin/.guile-real"))
;; We must avoid using a bare dollar sign in this code,
;; because it would be interpreted by the shell.
(dollar (string (integer->char 36))))
(chmod bin-dir #o755)
(rename-file guile guile-real)
(call-with-output-file guile
(lambda (p)
(format p "\
#!~a
export GUILE_SYSTEM_PATH=~a/share/guile/2.0
export GUILE_SYSTEM_COMPILED_PATH=~a/lib/guile/2.0/ccache
exec -a \"~a0\" ~a \"~a@\"\n"
bash out out dollar guile-real dollar)))
(chmod guile #o555)
(chmod bin-dir #o555))))))
(builder
(add-text-to-store store
"build-bootstrap-guile.sh"
(format #f "
bash out out dollar guile-real dollar)))
(chmod guile #o555)
(chmod bin-dir #o555))))))
(mlet* %store-monad ((tar (->store "tar"))
(xz (->store "xz"))
(mkdir (->store "mkdir"))
(bash (->store "bash"))
(guile (download-bootstrap-guile system))
(wrapper -> (make-guile-wrapper bash guile))
(builder
(text-file "build-bootstrap-guile.sh"
(format #f "
echo \"unpacking bootstrap Guile to '$out'...\"
~a $out
cd $out
@ -441,19 +442,19 @@ $out/bin/guile -c ~s $out ~a
# Sanity check.
$out/bin/guile --version~%"
(derivation->output-path mkdir)
(derivation->output-path xz)
(derivation->output-path tar)
(format #f "~s" make-guile-wrapper)
(derivation->output-path bash)))))
(derivation store name
(derivation->output-path bash) `(,builder)
#:system system
#:inputs (map derivation-input
(list bash mkdir tar xz guile))
#:sources (list builder)
#:env-vars `(("GUILE_TARBALL"
. ,(derivation->output-path guile))))))
(derivation->output-path mkdir)
(derivation->output-path xz)
(derivation->output-path tar)
(object->string wrapper)
(derivation->output-path bash)))))
(raw-derivation name
(derivation->output-path bash) `(,builder)
#:system system
#:inputs (map derivation-input
(list bash mkdir tar xz guile))
#:sources (list builder)
#:env-vars `(("GUILE_TARBALL"
. ,(derivation->output-path guile))))))
(define* (make-raw-bag name
#:key source inputs native-inputs outputs

View File

@ -52,6 +52,7 @@
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages rsync)
#:use-module (gnu packages xml)
#:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
@ -3375,7 +3376,7 @@ exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
;; if 'allowed-references' were per-output.
(arguments
`(#:allowed-references
((,gcc-boot0 "lib")
(,(gexp-input gcc-boot0 "lib")
,(kernel-headers-boot0)
,static-bash-for-glibc
,@(if (hurd-system?)

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -20,7 +21,8 @@
#:use-module (guix search-paths)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -34,62 +36,49 @@
(guix build syscalls)
,@%gnu-build-system-modules))
(define* (android-ndk-build store name inputs
#:key
(tests? #t)
(test-target #f)
(phases '(@ (guix build android-ndk-build-system)
%standard-phases))
(outputs '("out"))
(make-flags ''())
(search-paths '())
(system (%current-system))
(guile #f)
(imported-modules %android-ndk-build-system-modules)
(modules '((guix build android-ndk-build-system)
(guix build utils))))
(define* (android-ndk-build name inputs
#:key
source
(tests? #t)
(test-target #f)
(phases '(@ (guix build android-ndk-build-system)
%standard-phases))
(outputs '("out"))
(make-flags #~'())
(search-paths '())
(system (%current-system))
(guile #f)
(imported-modules %android-ndk-build-system-modules)
(modules '((guix build android-ndk-build-system)
(guix build utils))))
"Build SOURCE using Android NDK, and with INPUTS."
(define builder
`(begin
(use-modules ,@modules)
(android-ndk-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:test-target ,test-target
#:tests? ,tests?
#:phases ,phases
#:make-flags (cons* "-f"
,(string-append
(derivation->output-path
(car (assoc-ref inputs "android-build")))
"/share/android/build/core/main.mk")
,make-flags)
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(android-ndk-build #:name #$name
#:source #+source
#:system #$system
#:test-target #$test-target
#:tests? #$tests?
#:phases #$phases
#:make-flags
(cons* "-f"
#$(file-append (car (assoc-ref inputs
"android-build"))
"/share/android/build/core/main.mk")
#$make-flags)
#:outputs #$(outputs->gexp outputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs #$(input-tuples->gexp inputs)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
(define* (lower name
#:key source inputs native-inputs outputs system target
@ -98,7 +87,7 @@
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:inputs #:native-inputs #:outputs))
'(#:target #:inputs #:native-inputs #:outputs))
(and (not target) ;; TODO: support cross-compilation
(bag

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -20,7 +21,8 @@
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -73,7 +75,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:jdk #:ant #:zip #:inputs #:native-inputs))
'(#:target #:jdk #:ant #:zip #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
@ -94,8 +96,9 @@
(build ant-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (ant-build store name inputs
(define* (ant-build name inputs
#:key
source
(tests? #t)
(test-target "check")
(configure-flags ''())
@ -119,49 +122,34 @@
(guix build utils))))
"Build SOURCE with INPUTS."
(define builder
`(begin
(use-modules ,@modules)
(ant-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:make-flags ,make-flags
#:configure-flags ,configure-flags
#:system ,system
#:tests? ,tests?
#:test-target ,test-target
#:build-target ,build-target
#:jar-name ,jar-name
#:main-class ,main-class
#:test-include (list ,@test-include)
#:test-exclude (list ,@test-exclude)
#:source-dir ,source-dir
#:test-dir ,test-dir
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(ant-build #:name #$name
#:source #+source
#:make-flags #$make-flags
#:configure-flags #$configure-flags
#:system #$system
#:tests? #$tests?
#:test-target #$test-target
#:build-target #$build-target
#:jar-name #$jar-name
#:main-class #$main-class
#:test-include (list #$@test-include)
#:test-exclude (list #$@test-exclude)
#:source-dir #$source-dir
#:test-dir #$test-dir
#:phases #$phases
#:outputs #$(outputs->gexp outputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs #$(input-tuples->gexp inputs)))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
(define ant-build-system
(build-system

View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
;;; Copyright © 2019, 2020 Guillaume Le Vaillant <glv@posteo.net>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -22,7 +23,8 @@
#:use-module (guix utils)
#:use-module (guix memoization)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module ((guix build utils)
#:select ((package-name->name+version
@ -92,7 +94,7 @@
(build asdf-build/source)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (asdf-build/source store name inputs
(define* (asdf-build/source name inputs
#:key source outputs
(phases '(@ (guix build asdf-build-system)
%standard-phases/source))
@ -102,36 +104,23 @@
(imported-modules %asdf-build-system-modules)
(modules %asdf-build-modules))
(define builder
`(begin
(use-modules ,@modules)
(asdf-build/source #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source) source)
(source source))
#:system ,system
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(asdf-build/source #:name #$name
#:source #+source
#:system #$system
#:phases #$phases
#:outputs #$(outputs->gexp outputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs #$(input-tuples->gexp inputs)))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
(define* (package-with-build-system from-build-system to-build-system
from-prefix to-prefix
@ -277,19 +266,19 @@ set up using CL source package conventions."
(arguments (strip-keyword-arguments private-keywords arguments))))))
(define (asdf-build lisp-type)
(lambda* (store name inputs
#:key source outputs
(tests? #t)
(asd-files ''())
(asd-systems ''())
(test-asd-file #f)
(phases '(@ (guix build asdf-build-system)
%standard-phases))
(search-paths '())
(system (%current-system))
(guile #f)
(imported-modules %asdf-build-system-modules)
(modules %asdf-build-modules))
(lambda* (name inputs
#:key source outputs
(tests? #t)
(asd-files ''())
(asd-systems ''())
(test-asd-file #f)
(phases '(@ (guix build asdf-build-system)
%standard-phases))
(search-paths '())
(system (%current-system))
(guile #f)
(imported-modules %asdf-build-system-modules)
(modules %asdf-build-modules))
;; FIXME: The definition of 'systems' is pretty hacky.
;; Is there a more elegant way to do it?
@ -300,48 +289,35 @@ set up using CL source package conventions."
(string-drop
;; NAME is the value returned from `package-full-name'.
(hyphen-separated-name->name+version name)
(1+ (string-length lisp-type))))) ; drop the "<lisp>-" prefix.
(1+ (string-length lisp-type))))) ; drop the "<lisp>-" prefix.
asd-systems))
(define builder
`(begin
(use-modules ,@modules)
(parameterize ((%lisp (string-append
(assoc-ref %build-inputs ,lisp-type)
"/bin/" ,lisp-type))
(%lisp-type ,lisp-type))
(asdf-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source) source)
(source source))
#:asd-files ,asd-files
#:asd-systems ,systems
#:test-asd-file ,test-asd-file
#:system ,system
#:tests? ,tests?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs))))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(parameterize ((%lisp (string-append
(assoc-ref %build-inputs #$lisp-type)
"/bin/" #$lisp-type))
(%lisp-type #$lisp-type))
(asdf-build #:name #$name
#:source #+source
#:asd-files #$asd-files
#:asd-systems #$systems
#:test-asd-file #$test-asd-file
#:system #$system
#:tests? #$tests?
#:phases #$phases
#:outputs #$(outputs->gexp outputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs #$(input-tuples->gexp inputs))))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build)))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile))))
(define asdf-build-system/sbcl
(build-system

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
@ -26,7 +26,8 @@
#:use-module (guix search-paths)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -71,8 +72,9 @@ to NAME and VERSION."
(guix build json)
,@%cargo-utils-modules))
(define* (cargo-build store name inputs
(define* (cargo-build name inputs
#:key
source
(tests? #t)
(test-target #f)
(vendor-dir "guix-vendor")
@ -94,47 +96,37 @@ to NAME and VERSION."
"Build SOURCE using CARGO, and with INPUTS."
(define builder
`(begin
(use-modules ,@modules)
(cargo-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:test-target ,test-target
#:vendor-dir ,vendor-dir
#:cargo-build-flags ,cargo-build-flags
#:cargo-test-flags ,cargo-test-flags
#:cargo-package-flags ,cargo-package-flags
#:features ,features
#:skip-build? ,skip-build?
#:install-source? ,install-source?
#:tests? ,(and tests? (not skip-build?))
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(cargo-build #:name #$name
#:source #+source
#:system #$system
#:test-target #$test-target
#:vendor-dir #$vendor-dir
#:cargo-build-flags #$cargo-build-flags
#:cargo-test-flags #$cargo-test-flags
#:cargo-package-flags #$cargo-package-flags
#:features #$features
#:skip-build? #$skip-build?
#:install-source? #$install-source?
#:tests? #$(and tests? (not skip-build?))
#:phases #$phases
#:outputs (list #$@(map (lambda (name)
#~(cons #$name
(ungexp output name)))
outputs))
#:inputs (map (lambda (tuple)
(apply cons tuple))
'#$inputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(gexp->derivation name builder
#:system system
#:target #f
#:guile-for-build guile))
(define (package-cargo-inputs p)
(apply
@ -253,7 +245,7 @@ any dependent crates. This can be a benefits:
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:rust #:inputs #:native-inputs #:outputs
'(#:target #:rust #:inputs #:native-inputs #:outputs
#:cargo-inputs #:cargo-development-inputs))
(and (not target) ;; TODO: support cross-compilation

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 raingloom <raingloom@riseup.net>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -18,7 +19,9 @@
(define-module (guix build-system chicken)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -47,7 +50,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:chicken #:inputs #:native-inputs))
'(#:target #:chicken #:inputs #:native-inputs))
;; TODO: cross-compilation support
(and (not target)
@ -69,60 +72,45 @@
(build chicken-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (chicken-build store name inputs
#:key
(phases '(@ (guix build chicken-build-system)
%standard-phases))
(outputs '("out"))
(search-paths '())
(egg-name "")
(unpack-path "")
(build-flags ''())
(tests? #t)
(system (%current-system))
(guile #f)
(imported-modules %chicken-build-system-modules)
(modules '((guix build chicken-build-system)
(guix build union)
(guix build utils))))
(define* (chicken-build name inputs
#:key
source
(phases '(@ (guix build chicken-build-system)
%standard-phases))
(outputs '("out"))
(search-paths '())
(egg-name "")
(unpack-path "")
(build-flags ''())
(tests? #t)
(system (%current-system))
(guile #f)
(imported-modules %chicken-build-system-modules)
(modules '((guix build chicken-build-system)
(guix build union)
(guix build utils))))
(define builder
`(begin
(use-modules ,@modules)
(chicken-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:egg-name ,egg-name
#:unpack-path ,unpack-path
#:build-flags ,build-flags
#:tests? ,tests?
#:inputs %build-inputs)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(chicken-build #:name #$name
#:source #+source
#:system #$system
#:phases #$phases
#:outputs #$(outputs->gexp outputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:egg-name #$egg-name
#:unpack-path #$unpack-path
#:build-flags #$build-flags
#:tests? #$tests?
#:inputs #$(input-tuples->gexp inputs)))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system
#:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
(define chicken-build-system
(build-system

View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -25,7 +25,9 @@
#:select (standard-packages)
#:prefix gnu:)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module ((guix search-paths)
#:select
@ -102,26 +104,9 @@
(arguments (strip-keyword-arguments private-keywords
arguments))))))
(define-with-docs source->output-path
"Convert source input to output path."
(match-lambda
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source)))
(define-with-docs maybe-guile->guile
"Find the right guile."
(match-lambda
((and maybe-guile (? package?))
maybe-guile)
(#f ; default
(@* (gnu packages commencement) guile-final))))
(define* (clojure-build store name inputs
(define* (clojure-build name inputs
#:key
source
(source-dirs `',%source-dirs)
(test-dirs `',%test-dirs)
(compile-dir %compile-dir)
@ -133,7 +118,7 @@
(aot-include `',%aot-include)
(aot-exclude `',%aot-exclude)
doc-dirs ; no sensible default
doc-dirs ; no sensible default
(doc-regex %doc-regex)
(tests? %tests?)
@ -149,48 +134,44 @@
(imported-modules %clojure-build-system-modules)
(modules %default-modules))
"Build SOURCE with INPUTS."
(let ((builder `(begin
(use-modules ,@modules)
(clojure-build #:name ,name
#:source ,(source->output-path
(assoc-ref inputs "source"))
(define builder
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
#:source-dirs ,source-dirs
#:test-dirs ,test-dirs
#:compile-dir ,compile-dir
(clojure-build #:name #$name
#:source #+source
#:jar-names ,jar-names
#:main-class ,main-class
#:omit-source? ,omit-source?
#:source-dirs #$source-dirs
#:test-dirs #$test-dirs
#:compile-dir #$compile-dir
#:aot-include ,aot-include
#:aot-exclude ,aot-exclude
#:jar-names #$jar-names
#:main-class #$main-class
#:omit-source? #$omit-source?
#:doc-dirs ,doc-dirs
#:doc-regex ,doc-regex
#:aot-include #$aot-include
#:aot-exclude #$aot-exclude
#:tests? ,tests?
#:test-include ,test-include
#:test-exclude ,test-exclude
#:doc-dirs #$doc-dirs
#:doc-regex #$doc-regex
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-spec->sexp
search-paths)
#:system ,system
#:inputs %build-inputs)))
#:tests? #$tests?
#:test-include #$test-include
#:test-exclude #$test-exclude
(guile-for-build (package-derivation store
(maybe-guile->guile guile)
system
#:graft? #f)))
#:phases #$phases
#:outputs #$(outputs->gexp outputs)
#:search-paths '#$(map search-path-spec->sexp
search-paths)
#:system #$system
#:inputs #$(input-tuples->gexp inputs)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build)))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
(define clojure-build-system
(build-system

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
@ -21,7 +21,9 @@
(define-module (guix build-system cmake)
#:use-module (guix store)
#:use-module (guix gexp)
#:use-module (guix utils)
#:use-module (guix monads)
#:use-module (guix derivations)
#:use-module (guix search-paths)
#:use-module (guix build-system)
@ -61,7 +63,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
`(#:source #:cmake #:inputs #:native-inputs #:outputs
`(#:cmake #:inputs #:native-inputs
,@(if target '() '(#:target))))
(bag
@ -95,8 +97,8 @@
(build (if target cmake-cross-build cmake-build))
(arguments (strip-keyword-arguments private-keywords arguments))))
(define* (cmake-build store name inputs
#:key (guile #f)
(define* (cmake-build name inputs
#:key guile source
(outputs '("out")) (configure-flags ''())
(search-paths '())
(make-flags ''())
@ -120,62 +122,51 @@
(guix build utils))))
"Build SOURCE using CMAKE, and with INPUTS. This assumes that SOURCE
provides a 'CMakeLists.txt' file as its build system."
(define builder
`(begin
(use-modules ,@modules)
(cmake-build #:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:outputs %outputs
#:inputs %build-inputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:phases ,phases
#:configure-flags ,configure-flags
#:make-flags ,make-flags
#:out-of-source? ,out-of-source?
#:build-type ,build-type
#:tests? ,tests?
#:test-target ,test-target
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories)))
(define build
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
#$(with-build-variables inputs outputs
#~(cmake-build #:source #+source
#:system #$system
#:outputs %outputs
#:inputs %build-inputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:phases #$phases
#:configure-flags #$configure-flags
#:make-flags #$make-flags
#:out-of-source? #$out-of-source?
#:build-type #$build-type
#:tests? #$tests?
#:test-target #$test-target
#:parallel-build? #$parallel-build?
#:parallel-tests? #$parallel-tests?
#:validate-runpath? #$validate-runpath?
#:patch-shebangs? #$patch-shebangs?
#:strip-binaries? #$strip-binaries?
#:strip-flags #$strip-flags
#:strip-directories #$strip-directories)))))
(build-expression->derivation store name builder
#:system system
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:substitutable? substitutable?
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name build
#:system system
#:target #f
#:substitutable? substitutable?
#:guile-for-build guile)))
;;;
;;; Cross-compilation.
;;;
(define* (cmake-cross-build store name
(define* (cmake-cross-build name
#:key
target native-drvs target-drvs
(guile #f)
target
build-inputs target-inputs host-inputs
source guile
(outputs '("out"))
(configure-flags ''())
(search-paths '())
@ -205,78 +196,60 @@ provides a 'CMakeLists.txt' file as its build system."
with INPUTS. This assumes that SOURCE provides a 'CMakeLists.txt' file as its
build system."
(define builder
`(begin
(use-modules ,@modules)
(let ()
(define %build-host-inputs
',(map (match-lambda
((name (? derivation? drv) sub ...)
`(,name . ,(apply derivation->output-path drv sub)))
((name path)
`(,name . ,path)))
native-drvs))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@(sexp->gexp modules))
(define %build-target-inputs
',(map (match-lambda
((name (? derivation? drv) sub ...)
`(,name . ,(apply derivation->output-path drv sub)))
((name (? package? pkg) sub ...)
(let ((drv (package-cross-derivation store pkg
target system)))
`(,name . ,(apply derivation->output-path drv sub))))
((name path)
`(,name . ,path)))
target-drvs))
(define %build-host-inputs
(map (lambda (tuple)
(apply cons tuple))
'#+(append build-inputs target-inputs)))
(cmake-build #:source ,(match (assoc-ref native-drvs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:build ,build
#:target ,target
#:outputs %outputs
#:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:native-search-paths ',(map
search-path-specification->sexp
native-search-paths)
#:phases ,phases
#:configure-flags ,configure-flags
#:make-flags ,make-flags
#:out-of-source? ,out-of-source?
#:build-type ,build-type
#:tests? ,tests?
#:test-target ,test-target
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories))))
(define %build-target-inputs
(map (lambda (tuple)
(apply cons tuple))
'#$host-inputs))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(define %outputs
(list #$@(map (lambda (name)
#~(cons #$name
(ungexp output name)))
outputs)))
(build-expression->derivation store name builder
#:system system
#:inputs (append native-drvs target-drvs)
#:outputs outputs
#:modules imported-modules
#:substitutable? substitutable?
#:guile-for-build guile-for-build))
(cmake-build #:source #+source
#:system #$system
#:build #$build
#:target #$target
#:outputs %outputs
#:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:native-search-paths '#$(map
search-path-specification->sexp
native-search-paths)
#:phases #$phases
#:configure-flags #$configure-flags
#:make-flags #$make-flags
#:out-of-source? #$out-of-source?
#:build-type #$build-type
#:tests? #$tests?
#:test-target #$test-target
#:parallel-build? #$parallel-build?
#:parallel-tests? #$parallel-tests?
#:validate-runpath? #$validate-runpath?
#:patch-shebangs? #$patch-shebangs?
#:strip-binaries? #$strip-binaries?
#:strip-flags #$strip-flags
#:strip-directories #$strip-directories))))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:target target
#:substitutable? substitutable?
#:guile-for-build guile)))
(define cmake-build-system
(build-system

View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2020 Pierre Neidhardt <mail@ambrevar.xyz>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -20,7 +21,8 @@
(define-module (guix build-system copy)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -59,7 +61,7 @@
#:rest arguments)
"Return a bag for NAME from the given arguments."
(define private-keywords
'(#:source #:target #:inputs #:native-inputs))
'(#:target #:inputs #:native-inputs))
(bag
(name name)
@ -75,8 +77,9 @@
(build copy-build)
(arguments (strip-keyword-arguments private-keywords arguments))))
(define* (copy-build store name inputs
#:key (guile #f)
(define* (copy-build name inputs
#:key
guile source
(outputs '("out"))
(install-plan ''(("." "./")))
(search-paths '())
@ -90,49 +93,38 @@
(phases '(@ (guix build copy-build-system)
%standard-phases))
(system (%current-system))
(target #f)
(imported-modules %copy-build-system-modules)
(modules '((guix build copy-build-system)
(guix build utils))))
"Build SOURCE using INSTALL-PLAN, and with INPUTS."
(define builder
`(begin
(use-modules ,@modules)
(copy-build #:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:outputs %outputs
#:inputs %build-inputs
#:install-plan ,install-plan
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:phases ,phases
#:out-of-source? ,out-of-source?
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
#$(with-build-variables inputs outputs
#~(copy-build #:source #+source
#:system #$system
#:outputs %outputs
#:inputs %build-inputs
#:install-plan #$install-plan
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:phases #$phases
#:out-of-source? #$out-of-source?
#:validate-runpath? #$validate-runpath?
#:patch-shebangs? #$patch-shebangs?
#:strip-binaries? #$strip-binaries?
#:strip-flags #$strip-flags
#:strip-directories #$strip-directories)))))
(build-expression->derivation store name builder
#:system system
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:target #f
#:guile-for-build guile)))
(define copy-build-system
(build-system

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
@ -24,7 +24,8 @@
#:use-module (guix search-paths)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -56,57 +57,43 @@
(guix build syscalls)
,@%gnu-build-system-modules))
(define* (dub-build store name inputs
#:key
(tests? #t)
(test-target #f)
(dub-build-flags ''())
(phases '(@ (guix build dub-build-system)
%standard-phases))
(outputs '("out"))
(search-paths '())
(system (%current-system))
(guile #f)
(imported-modules %dub-build-system-modules)
(modules '((guix build dub-build-system)
(guix build utils))))
(define* (dub-build name inputs
#:key
source
(tests? #t)
(test-target #f)
(dub-build-flags ''())
(phases '(@ (guix build dub-build-system)
%standard-phases))
(outputs '("out"))
(search-paths '())
(system (%current-system))
(guile #f)
(imported-modules %dub-build-system-modules)
(modules '((guix build dub-build-system)
(guix build utils))))
"Build SOURCE using DUB, and with INPUTS."
(define builder
`(begin
(use-modules ,@modules)
(dub-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:test-target ,test-target
#:dub-build-flags ,dub-build-flags
#:tests? ,tests?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(dub-build #:name #$name
#:source #+source
#:system #$system
#:test-target #$test-target
#:dub-build-flags #$dub-build-flags
#:tests? #$tests?
#:phases #$phases
#:outputs #$(outputs->gexp outputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs #$(input-tuples->gexp inputs)))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
(define* (lower name
#:key source inputs native-inputs outputs system target
@ -118,7 +105,7 @@
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:ldc #:dub #:pkg-config #:inputs #:native-inputs #:outputs))
'(#:target #:ldc #:dub #:pkg-config #:inputs #:native-inputs #:outputs))
(and (not target) ;; TODO: support cross-compilation
(bag

View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2017 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -20,7 +21,7 @@
(define-module (guix build-system dune)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module ((guix build-system gnu) #:prefix gnu:)
@ -60,7 +61,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:dune #:findlib #:ocaml #:inputs #:native-inputs))
'(#:target #:dune #:findlib #:ocaml #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(let ((base (ocaml:lower name
@ -80,8 +81,9 @@
(build dune-build)
(arguments (strip-keyword-arguments private-keywords arguments))))))
(define* (dune-build store name inputs
#:key (guile #f)
(define* (dune-build name inputs
#:key
guile source
(outputs '("out"))
(search-paths '())
(build-flags ''())
@ -107,50 +109,39 @@
"Build SOURCE using OCAML, and with INPUTS. This assumes that SOURCE
provides a 'setup.ml' file as its build system."
(define builder
`(begin
(use-modules ,@modules)
(dune-build #:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:outputs %outputs
#:inputs %build-inputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:phases ,phases
#:test-flags ,test-flags
#:build-flags ,build-flags
#:out-of-source? ,out-of-source?
#:jbuild? ,jbuild?
#:package ,package
#:tests? ,tests?
#:test-target ,test-target
#:install-target ,install-target
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(dune-build #:source #$source
#:system #$system
#:outputs (list #$@(map (lambda (name)
#~(cons #$name
(ungexp output name)))
outputs))
#:inputs (map (lambda (tuple)
(apply cons tuple))
'#$inputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:phases #$phases
#:test-flags #$test-flags
#:build-flags #$build-flags
#:out-of-source? #$out-of-source?
#:jbuild? #$jbuild?
#:package #$package
#:tests? #$tests?
#:test-target #$test-target
#:install-target #$install-target
#:validate-runpath? #$validate-runpath?
#:patch-shebangs? #$patch-shebangs?
#:strip-binaries? #$strip-binaries?
#:strip-flags #$strip-flags
#:strip-directories #$strip-directories))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(gexp->derivation name builder
#:system system
#:target #f
#:guile-for-build guile))
(define dune-build-system
(build-system

View File

@ -23,7 +23,8 @@
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -81,7 +82,7 @@
(build emacs-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (emacs-build store name inputs
(define* (emacs-build name inputs
#:key source
(tests? #f)
(parallel-tests? #t)
@ -100,43 +101,28 @@
(guix build emacs-utils))))
"Build SOURCE using EMACS, and with INPUTS."
(define builder
`(begin
(use-modules ,@modules)
(emacs-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:test-command ,test-command
#:tests? ,tests?
#:parallel-tests? ,parallel-tests?
#:phases ,phases
#:outputs %outputs
#:include ,include
#:exclude ,exclude
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(emacs-build #:name #$name
#:source #+source
#:system #$system
#:test-command #$test-command
#:tests? #$tests?
#:parallel-tests? #$parallel-tests?
#:phases #$phases
#:outputs #$(outputs->gexp outputs)
#:include #$include
#:exclude #$exclude
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs #$(input-tuples->gexp inputs)))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
(define emacs-build-system
(build-system

View File

@ -17,6 +17,9 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build-system font)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix derivations)
@ -69,7 +72,7 @@
(build font-build)
(arguments (strip-keyword-arguments private-keywords arguments))))
(define* (font-build store name inputs
(define* (font-build name inputs
#:key source
(tests? #t)
(test-target "test")
@ -85,41 +88,29 @@
(guix build utils))))
"Build SOURCE with INPUTS."
(define builder
`(begin
(use-modules ,@modules)
(font-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:configure-flags ,configure-flags
#:system ,system
#:test-target ,test-target
#:tests? ,tests?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
#$(with-build-variables inputs outputs
#~(font-build #:name #$name
#:source #+source
#:configure-flags #$configure-flags
#:system #$system
#:test-target #$test-target
#:tests? #$tests?
#:phases #$phases
#:outputs %outputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:target #f
#:guile-for-build guile)))
(define font-build-system
(build-system

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch>
;;;
@ -21,6 +21,8 @@
(define-module (guix build-system glib-or-gtk)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix derivations)
#:use-module (guix search-paths)
#:use-module (guix build-system)
@ -85,7 +87,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:glib #:inputs #:native-inputs
'(#:target #:glib #:inputs #:native-inputs
#:outputs #:implicit-inputs?))
(and (not target) ;XXX: no cross-compilation
@ -105,8 +107,8 @@
(build glib-or-gtk-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (glib-or-gtk-build store name inputs
#:key (guile #f)
(define* (glib-or-gtk-build name inputs
#:key guile source
(outputs '("out"))
(search-paths '())
(configure-flags ''())
@ -132,70 +134,43 @@
allowed-references
disallowed-references)
"Build SOURCE with INPUTS. See GNU-BUILD for more details."
(define canonicalize-reference
(match-lambda
((? package? p)
(derivation->output-path (package-derivation store p system)))
(((? package? p) output)
(derivation->output-path (package-derivation store p system)
output))
((? string? output)
output)))
(define build
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(define builder
`(begin
(use-modules ,@modules)
(glib-or-gtk-build #:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:outputs %outputs
#:inputs %build-inputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:phases ,phases
#:glib-or-gtk-wrap-excluded-outputs
,glib-or-gtk-wrap-excluded-outputs
#:configure-flags ,configure-flags
#:make-flags ,make-flags
#:out-of-source? ,out-of-source?
#:tests? ,tests?
#:test-target ,test-target
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories)))
#$(with-build-variables inputs outputs
#~(glib-or-gtk-build #:source #+source
#:system #$system
#:outputs %outputs
#:inputs %build-inputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:phases #$phases
#:glib-or-gtk-wrap-excluded-outputs
#$glib-or-gtk-wrap-excluded-outputs
#:configure-flags #$configure-flags
#:make-flags #$make-flags
#:out-of-source? #$out-of-source?
#:tests? #$tests?
#:test-target #$test-target
#:parallel-build? #$parallel-build?
#:parallel-tests? #$parallel-tests?
#:validate-runpath? #$validate-runpath?
#:patch-shebangs? #$patch-shebangs?
#:strip-binaries? #$strip-binaries?
#:strip-flags #$strip-flags
#:strip-directories #$strip-directories)))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:allowed-references
(and allowed-references
(map canonicalize-reference
allowed-references))
#:disallowed-references
(and disallowed-references
(map canonicalize-reference
disallowed-references))
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name build
#:system system
#:target #f
#:allowed-references allowed-references
#:disallowed-references disallowed-references
#:guile-for-build guile)))
(define glib-or-gtk-build-system
(build-system

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -20,6 +20,8 @@
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix memoization)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix derivations)
#:use-module (guix search-paths)
#:use-module (guix build-system)
@ -281,7 +283,7 @@ standard packages used as implicit inputs of the GNU build system."
#:rest arguments)
"Return a bag for NAME from the given arguments."
(define private-keywords
`(#:source #:inputs #:native-inputs #:outputs
`(#:inputs #:native-inputs #:outputs
#:implicit-inputs? #:implicit-cross-inputs?
,@(if target '() '(#:target))))
@ -328,8 +330,9 @@ standard packages used as implicit inputs of the GNU build system."
;; Typical names of Autotools "bootstrap" scripts.
'("bootstrap" "bootstrap.sh" "autogen.sh"))
(define* (gnu-build store name input-drvs
#:key (guile #f)
(define* (gnu-build name inputs
#:key
guile source
(outputs '("out"))
(search-paths '())
(bootstrap-scripts (list 'quote %bootstrap-scripts))
@ -374,80 +377,48 @@ SUBSTITUTABLE? determines whether users may be able to use substitutes of the
returned derivations, or whether they should always build it locally.
ALLOWED-REFERENCES can be either #f, or a list of packages that the outputs
are allowed to refer to. Likewise for DISALLOWED-REFERENCES, which lists
packages that must not be referenced."
(define canonicalize-reference
(match-lambda
((? package? p)
(derivation->output-path (package-derivation store p system
#:graft? #f)))
(((? package? p) output)
(derivation->output-path (package-derivation store p system
#:graft? #f)
output))
((? string? output)
output)))
are allowed to refer to."
(define builder
`(begin
(use-modules ,@modules)
(gnu-build #:source ,(match (assoc-ref input-drvs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:build ,build
#:outputs %outputs
#:inputs %build-inputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:phases ,phases
#:locale ,locale
#:bootstrap-scripts ,bootstrap-scripts
#:configure-flags ,configure-flags
#:make-flags ,make-flags
#:out-of-source? ,out-of-source?
#:tests? ,tests?
#:test-target ,test-target
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:validate-runpath? ,validate-runpath?
#:make-dynamic-linker-cache? ,make-dynamic-linker-cache?
#:license-file-regexp ,license-file-regexp
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system
#:graft? #f)))))
#$(with-build-variables inputs outputs
#~(gnu-build #:source #+source
#:system #$system
#:build #$build
#:outputs %outputs
#:inputs %build-inputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:phases #$phases
#:locale #$locale
#:bootstrap-scripts #$bootstrap-scripts
#:configure-flags #$configure-flags
#:make-flags #$make-flags
#:out-of-source? #$out-of-source?
#:tests? #$tests?
#:test-target #$test-target
#:parallel-build? #$parallel-build?
#:parallel-tests? #$parallel-tests?
#:patch-shebangs? #$patch-shebangs?
#:license-file-regexp #$license-file-regexp
#:strip-binaries? #$strip-binaries?
#:validate-runpath? #$validate-runpath?
#:make-dynamic-linker-cache? #$make-dynamic-linker-cache?
#:license-file-regexp #$license-file-regexp
#:strip-flags #$strip-flags
#:strip-directories #$strip-directories)))))
(build-expression->derivation store name builder
#:system system
#:inputs input-drvs
#:outputs outputs
#:modules imported-modules
#:substitutable? substitutable?
#:allowed-references
(and allowed-references
(map canonicalize-reference
allowed-references))
#:disallowed-references
(and disallowed-references
(map canonicalize-reference
disallowed-references))
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:target #f
#:substitutable? substitutable?
#:allowed-references allowed-references
#:disallowed-references disallowed-references
#:guile-for-build guile)))
;;;
@ -483,11 +454,11 @@ is one of `host' or `target'."
`(("cross-libc:static" ,libc "static"))
'()))))))))
(define* (gnu-cross-build store name
(define* (gnu-cross-build name
#:key
target native-drvs target-drvs
(guile #f)
source
target
build-inputs target-inputs host-inputs
guile source
(outputs '("out"))
(search-paths '())
(native-search-paths '())
@ -525,104 +496,67 @@ is one of `host' or `target'."
"Cross-build NAME for TARGET, where TARGET is a GNU triplet. INPUTS are
cross-built inputs, and NATIVE-INPUTS are inputs that run on the build
platform."
(define canonicalize-reference
(match-lambda
((? package? p)
(derivation->output-path (package-cross-derivation store p
target system)))
(((? package? p) output)
(derivation->output-path (package-cross-derivation store p
target system)
output))
((? string? output)
output)))
(define builder
`(begin
(use-modules ,@modules)
#~(begin
(use-modules #$@modules)
(let ()
(define %build-host-inputs
',(map (match-lambda
((name (? derivation? drv) sub ...)
`(,name . ,(apply derivation->output-path drv sub)))
((name path)
`(,name . ,path)))
native-drvs))
(define %build-host-inputs
(map (lambda (tuple)
(apply cons tuple))
'#+build-inputs))
(define %build-target-inputs
',(map (match-lambda
((name (? derivation? drv) sub ...)
`(,name . ,(apply derivation->output-path drv sub)))
((name (? package? pkg) sub ...)
(let ((drv (package-cross-derivation store pkg
target system)))
`(,name . ,(apply derivation->output-path drv sub))))
((name path)
`(,name . ,path)))
target-drvs))
(define %build-target-inputs
(map (lambda (tuple)
(apply cons tuple))
(append '#$host-inputs '#+target-inputs)))
(gnu-build #:source ,(match (assoc-ref native-drvs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:build ,build
#:target ,target
#:outputs %outputs
#:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths ',(map search-path-specification->sexp
(define %outputs
(list #$@(map (lambda (name)
#~(cons #$name
(ungexp output name)))
outputs)))
(gnu-build #:source #+source
#:system #$system
#:build #$build
#:target #$target
#:outputs %outputs
#:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:native-search-paths ',(map
#:native-search-paths '#$(map
search-path-specification->sexp
native-search-paths)
#:phases ,phases
#:locale ,locale
#:bootstrap-scripts ,bootstrap-scripts
#:configure-flags ,configure-flags
#:make-flags ,make-flags
#:out-of-source? ,out-of-source?
#:tests? ,tests?
#:test-target ,test-target
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:validate-runpath? ,validate-runpath?
#:make-dynamic-linker-cache? ,make-dynamic-linker-cache?
#:license-file-regexp ,license-file-regexp
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories))))
#:phases #$phases
#:locale #$locale
#:bootstrap-scripts #$bootstrap-scripts
#:configure-flags #$configure-flags
#:make-flags #$make-flags
#:out-of-source? #$out-of-source?
#:tests? #$tests?
#:test-target #$test-target
#:parallel-build? #$parallel-build?
#:parallel-tests? #$parallel-tests?
#:patch-shebangs? #$patch-shebangs?
#:license-file-regexp #$license-file-regexp
#:strip-binaries? #$strip-binaries?
#:validate-runpath? #$validate-runpath?
#:make-dynamic-linker-cache? #$make-dynamic-linker-cache?
#:license-file-regexp #$license-file-regexp
#:strip-flags #$strip-flags
#:strip-directories #$strip-directories)))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system
#:inputs (append native-drvs target-drvs)
#:outputs outputs
#:modules imported-modules
#:substitutable? substitutable?
#:allowed-references
(and allowed-references
(map canonicalize-reference
allowed-references))
#:disallowed-references
(and disallowed-references
(map canonicalize-reference
disallowed-references))
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:target target
#:modules imported-modules
#:substitutable? substitutable?
#:allowed-references allowed-references
#:disallowed-references disallowed-references
#:guile-for-build guile)))
(define gnu-build-system
(build-system

View File

@ -2,6 +2,7 @@
;;; Copyright © 2016 Petter <petter@mykolab.ch>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -20,7 +21,9 @@
(define-module (guix build-system go)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -88,7 +91,7 @@ it, defaulting to full VERSION if a pseudo-version pattern is not recognized."
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:go #:inputs #:native-inputs))
'(#:target #:go #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
@ -107,8 +110,9 @@ it, defaulting to full VERSION if a pseudo-version pattern is not recognized."
(build go-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (go-build store name inputs
(define* (go-build name inputs
#:key
source
(phases '(@ (guix build go-build-system)
%standard-phases))
(outputs '("out"))
@ -126,45 +130,29 @@ it, defaulting to full VERSION if a pseudo-version pattern is not recognized."
(guix build union)
(guix build utils))))
(define builder
`(begin
(use-modules ,@modules)
(go-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:install-source? ,install-source?
#:import-path ,import-path
#:unpack-path ,unpack-path
#:build-flags ,build-flags
#:tests? ,tests?
#:allow-go-reference? ,allow-go-reference?
#:inputs %build-inputs)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(go-build #:name #$name
#:source #+source
#:system #$system
#:phases #$phases
#:outputs #$(outputs->gexp outputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:install-source? #$install-source?
#:import-path #$import-path
#:unpack-path #$unpack-path
#:build-flags #$build-flags
#:tests? #$tests?
#:allow-go-reference? #$allow-go-reference?
#:inputs #$(input-tuples->gexp inputs)))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system
#:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
(define go-build-system
(build-system

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -20,7 +20,8 @@
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix monads)
#:use-module (guix gexp)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -75,7 +76,7 @@
;; denominator between Guile 2.0 and 2.2.
''("-Wunbound-variable" "-Warity-mismatch" "-Wformat"))
(define* (guile-build store name inputs
(define* (guile-build name inputs
#:key source
(guile #f)
(phases '%standard-phases)
@ -91,47 +92,34 @@
(guix build utils))))
"Build SOURCE using Guile taken from the native inputs, and with INPUTS."
(define builder
`(begin
(use-modules ,@modules)
(guile-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:source-directory ,source-directory
#:scheme-file-regexp ,scheme-file-regexp
#:not-compiled-file-regexp ,not-compiled-file-regexp
#:compile-flags ,compile-flags
#:phases ,phases
#:system ,system
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(guile-build #:name #$name
#:source #+source
#:source-directory #$source-directory
#:scheme-file-regexp #$scheme-file-regexp
#:not-compiled-file-regexp #$not-compiled-file-regexp
#:compile-flags #$compile-flags
#:phases #$phases
#:system #$system
#:outputs #$(outputs->gexp outputs)
#:inputs #$(input-tuples->gexp inputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:target #f
#:guile-for-build guile)))
(define* (guile-cross-build store name
(define* (guile-cross-build name
#:key
(system (%current-system)) target
native-drvs target-drvs
build-inputs target-inputs host-inputs
(guile #f)
source
(outputs '("out"))
@ -146,68 +134,42 @@
(modules '((guix build guile-build-system)
(guix build utils))))
(define builder
`(begin
(use-modules ,@modules)
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(let ()
(define %build-host-inputs
',(map (match-lambda
((name (? derivation? drv) sub ...)
`(,name . ,(apply derivation->output-path drv sub)))
((name path)
`(,name . ,path)))
native-drvs))
(define %build-host-inputs
#+(input-tuples->gexp build-inputs))
(define %build-target-inputs
',(map (match-lambda
((name (? derivation? drv) sub ...)
`(,name . ,(apply derivation->output-path drv sub)))
((name (? package? pkg) sub ...)
(let ((drv (package-cross-derivation store pkg
target system)))
`(,name . ,(apply derivation->output-path drv sub))))
((name path)
`(,name . ,path)))
target-drvs))
(define %build-target-inputs
(append #$(input-tuples->gexp host-inputs)
#+(input-tuples->gexp target-inputs)))
(guile-build #:source ,(match (assoc-ref native-drvs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:target ,target
#:outputs %outputs
#:source-directory ,source-directory
#:not-compiled-file-regexp ,not-compiled-file-regexp
#:compile-flags ,compile-flags
#:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:native-search-paths ',(map
search-path-specification->sexp
native-search-paths)
#:phases ,phases))))
(define %outputs
#$(outputs->gexp outputs))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(guile-build #:source #+source
#:system #$system
#:target #$target
#:outputs %outputs
#:source-directory #$source-directory
#:not-compiled-file-regexp #$not-compiled-file-regexp
#:compile-flags #$compile-flags
#:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:native-search-paths '#$(map
search-path-specification->sexp
native-search-paths)
#:phases #$phases))))
(build-expression->derivation store name builder
#:system system
#:inputs (append native-drvs target-drvs)
#:outputs outputs
#:modules imported-modules
#:substitutable? substitutable?
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:target target
#:guile-for-build guile)))
(define guile-build-system
(build-system

View File

@ -2,6 +2,7 @@
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -22,7 +23,8 @@
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix download)
#:use-module (guix search-paths)
#:use-module (guix build-system)
@ -116,7 +118,7 @@ version REVISION."
(cons name propagated-names))))))
extra-directories))))))))
(define* (haskell-build store name inputs
(define* (haskell-build name inputs
#:key source
(haddock? #t)
(haddock-flags ''())
@ -139,50 +141,33 @@ version REVISION."
"Build SOURCE using HASKELL, and with INPUTS. This assumes that SOURCE
provides a 'Setup.hs' file as its build system."
(define builder
`(begin
(use-modules ,@modules)
(haskell-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:cabal-revision ,(match (assoc-ref inputs
"cabal-revision")
(((? derivation? revision))
(derivation->output-path revision))
(revision revision))
#:configure-flags ,configure-flags
#:extra-directories ,extra-directories
#:haddock-flags ,haddock-flags
#:system ,system
#:test-target ,test-target
#:tests? ,tests?
#:parallel-build? ,parallel-build?
#:haddock? ,haddock?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(haskell-build #:name #$name
#:source #+source
#:cabal-revision #$(assoc-ref inputs
"cabal-revision")
#:configure-flags #$configure-flags
#:extra-directories #$extra-directories
#:haddock-flags #$haddock-flags
#:system #$system
#:test-target #$test-target
#:tests? #$tests?
#:parallel-build? #$parallel-build?
#:haddock? #$haddock?
#:phases #$phases
#:outputs #$(outputs->gexp outputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs #$(input-tuples->gexp inputs)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
(define haskell-build-system
(build-system

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Nicolò Balzarotti <nicolo@nixo.xyz>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -20,7 +21,8 @@
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -73,7 +75,7 @@
(build julia-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (julia-build store name inputs
(define* (julia-build name inputs
#:key source
(tests? #t)
(phases '(@ (guix build julia-build-system)
@ -88,40 +90,25 @@
(guix build utils))))
"Build SOURCE using Julia, and with INPUTS."
(define builder
`(begin
(use-modules ,@modules)
(julia-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:tests? ,tests?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs
#:julia-package-name ,julia-package-name)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(julia-build #:name #$name
#:source #+source
#:system #$system
#:tests? #$tests?
#:phases #$phases
#:outputs #$(outputs->gexp outputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs #$(input-tuples->gexp inputs)
#:julia-package-name #$julia-package-name))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
(define julia-build-system
(build-system

View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -20,7 +21,8 @@
(define-module (guix build-system linux-module)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -114,7 +116,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
`(#:source #:target #:gcc #:kmod #:linux #:inputs #:native-inputs
`(#:target #:gcc #:kmod #:linux #:inputs #:native-inputs
,@(if target '() '(#:target))))
(bag
@ -148,9 +150,9 @@
(build (if target linux-module-build-cross linux-module-build))
(arguments (strip-keyword-arguments private-keywords arguments))))
(define* (linux-module-build store name inputs
(define* (linux-module-build name inputs
#:key
target
source target
(search-paths '())
(tests? #t)
(phases '(@ (guix build linux-module-build-system)
@ -166,48 +168,34 @@
(guix build utils))))
"Build SOURCE using LINUX, and with INPUTS."
(define builder
`(begin
(use-modules ,@modules)
(linux-module-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:phases ,phases
#:system ,system
#:target ,target
#:arch ,(system->arch (or target system))
#:tests? ,tests?
#:outputs %outputs
#:make-flags ,make-flags
#:inputs %build-inputs)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(linux-module-build #:name #$name
#:source #+source
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:phases #$phases
#:system #$system
#:target #$target
#:arch #$(system->arch (or target system))
#:tests? #$tests?
#:outputs #$(outputs->gexp outputs)
#:make-flags #$make-flags
#:inputs #$(input-tuples->gexp inputs)))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build
#:substitutable? substitutable?))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile
#:substitutable? substitutable?)))
(define* (linux-module-build-cross
store name
name
#:key
target native-drvs target-drvs
source target
build-inputs target-inputs host-inputs
(guile #f)
(outputs '("out"))
(make-flags ''())
@ -223,70 +211,42 @@
(modules '((guix build linux-module-build-system)
(guix build utils))))
(define builder
`(begin
(use-modules ,@modules)
(let ()
(define %build-host-inputs
',(map (match-lambda
((name (? derivation? drv) sub ...)
`(,name . ,(apply derivation->output-path drv sub)))
((name path)
`(,name . ,path)))
native-drvs))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(define %build-target-inputs
',(map (match-lambda
((name (? derivation? drv) sub ...)
`(,name . ,(apply derivation->output-path drv sub)))
((name (? package? pkg) sub ...)
(let ((drv (package-cross-derivation store pkg
target system)))
`(,name . ,(apply derivation->output-path drv sub))))
((name path)
`(,name . ,path)))
target-drvs))
(define %build-host-inputs
'#+(input-tuples->gexp build-inputs))
(linux-module-build #:name ,name
#:source ,(match (assoc-ref native-drvs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:target ,target
#:arch ,(system->arch (or target system))
#:outputs %outputs
#:make-flags ,make-flags
#:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths
',(map search-path-specification->sexp
search-paths)
#:native-search-paths
',(map
search-path-specification->sexp
native-search-paths)
#:phases ,phases
#:tests? ,tests?))))
(define %build-target-inputs
(append #$(input-tuples->gexp host-inputs)
#+(input-tuples->gexp target-inputs)))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(linux-module-build #:name #$name
#:source #+source
#:system #$system
#:target #$target
#:arch #$(system->arch (or target system))
#:outputs #$(outputs->gexp outputs)
#:make-flags #$make-flags
#:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths
'#$(map search-path-specification->sexp
search-paths)
#:native-search-paths
'#$(map
search-path-specification->sexp
native-search-paths)
#:phases #$phases
#:tests? #$tests?))))
(build-expression->derivation store name builder
#:system system
#:inputs (append native-drvs target-drvs)
#:outputs outputs
#:modules imported-modules
#:guile-for-build guile-for-build
#:substitutable? substitutable?))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile
#:substitutable? substitutable?)))
(define linux-module-build-system
(build-system

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -19,7 +20,8 @@
(define-module (guix build-system maven)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -119,7 +121,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:jdk #:maven #:maven-plugins #:inputs #:native-inputs))
'(#:target #:jdk #:maven #:maven-plugins #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
@ -140,70 +142,56 @@
(build maven-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (maven-build store name inputs
#:key (guile #f)
(outputs '("out"))
(search-paths '())
(out-of-source? #t)
(validate-runpath? #t)
(patch-shebangs? #t)
(strip-binaries? #t)
(exclude %default-exclude)
(local-packages '())
(tests? #t)
(strip-flags ''("--strip-debug"))
(strip-directories ''("lib" "lib64" "libexec"
"bin" "sbin"))
(phases '(@ (guix build maven-build-system)
%standard-phases))
(system (%current-system))
(imported-modules %maven-build-system-modules)
(modules '((guix build maven-build-system)
(guix build maven pom)
(guix build utils))))
(define* (maven-build name inputs
#:key
source (guile #f)
(outputs '("out"))
(search-paths '())
(out-of-source? #t)
(validate-runpath? #t)
(patch-shebangs? #t)
(strip-binaries? #t)
(exclude %default-exclude)
(local-packages '())
(tests? #t)
(strip-flags ''("--strip-debug"))
(strip-directories ''("lib" "lib64" "libexec"
"bin" "sbin"))
(phases '(@ (guix build maven-build-system)
%standard-phases))
(system (%current-system))
(imported-modules %maven-build-system-modules)
(modules '((guix build maven-build-system)
(guix build maven pom)
(guix build utils))))
"Build SOURCE using PATCHELF, and with INPUTS. This assumes that SOURCE
provides its own binaries."
(define builder
`(begin
(use-modules ,@modules)
(maven-build #:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:outputs %outputs
#:inputs %build-inputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:phases ,phases
#:exclude (quote ,exclude)
#:local-packages (quote ,local-packages)
#:tests? ,tests?
#:out-of-source? ,out-of-source?
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(maven-build #:source #+source
#:system #$system
#:outputs #$(outputs->gexp outputs)
#:inputs #$(input-tuples->gexp inputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:phases #$phases
#:exclude '#$exclude
#:local-packages '#$local-packages
#:tests? #$tests?
#:out-of-source? #$out-of-source?
#:validate-runpath? #$validate-runpath?
#:patch-shebangs? #$patch-shebangs?
#:strip-binaries? #$strip-binaries?
#:strip-flags #$strip-flags
#:strip-directories #$strip-directories))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
(define maven-build-system
(build-system

View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com>
;;; Copyright © 2018, 2019 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -18,9 +19,10 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build-system meson)
#:use-module (guix store)
#:use-module (guix gexp)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -66,7 +68,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
`(#:source #:meson #:ninja #:inputs #:native-inputs #:outputs #:target))
`(#:meson #:ninja #:inputs #:native-inputs #:outputs #:target))
(and (not target) ;; TODO: add support for cross-compilation.
(bag
@ -85,8 +87,9 @@
(build meson-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (meson-build store name inputs
#:key (guile #f)
(define* (meson-build name inputs
#:key
guile source
(outputs '("out"))
(configure-flags ''())
(search-paths '())
@ -114,76 +117,48 @@
disallowed-references)
"Build SOURCE using MESON, and with INPUTS, assuming that SOURCE
has a 'meson.build' file."
;; TODO: Copied from build-system/gnu, factorize this!
(define canonicalize-reference
(match-lambda
((? package? p)
(derivation->output-path (package-derivation store p system
#:graft? #f)))
(((? package? p) output)
(derivation->output-path (package-derivation store p system
#:graft? #f)
output))
((? string? output)
output)))
(define builder
`(let ((build-phases (if ,glib-or-gtk?
,phases
(modify-phases ,phases
(delete 'glib-or-gtk-compile-schemas)
(delete 'glib-or-gtk-wrap)))))
(use-modules ,@modules)
(meson-build #:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:outputs %outputs
#:inputs %build-inputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:phases build-phases
#:configure-flags ,configure-flags
#:build-type ,build-type
#:tests? ,tests?
#:test-target ,test-target
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories
#:elf-directories ,elf-directories)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(define build-phases
#$(if glib-or-gtk?
phases
#~(modify-phases #$phases
(delete 'glib-or-gtk-compile-schemas)
(delete 'glib-or-gtk-wrap))))
(build-expression->derivation store name builder
#:system system
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build
#:allowed-references
(and allowed-references
(map canonicalize-reference
allowed-references))
#:disallowed-references
(and disallowed-references
(map canonicalize-reference
disallowed-references))))
#$(with-build-variables inputs outputs
#~(meson-build #:source #+source
#:system #$system
#:outputs %outputs
#:inputs %build-inputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:phases build-phases
#:configure-flags #$configure-flags
#:build-type #$build-type
#:tests? #$tests?
#:test-target #$test-target
#:parallel-build? #$parallel-build?
#:parallel-tests? #$parallel-tests?
#:validate-runpath? #$validate-runpath?
#:patch-shebangs? #$patch-shebangs?
#:strip-binaries? #$strip-binaries?
#:strip-flags #$strip-flags
#:strip-directories #$strip-directories
#:elf-directories #$elf-directories)))))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:target #f
#:substitutable? substitutable?
#:allowed-references allowed-references
#:disallowed-references disallowed-references
#:guile-for-build guile)))
(define meson-build-system
(build-system

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -20,7 +21,8 @@
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -54,7 +56,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:inputs #:native-inputs))
'(#:target #:inputs #:native-inputs))
(bag
(name name)
@ -70,8 +72,9 @@
(build minify-build)
(arguments (strip-keyword-arguments private-keywords arguments))))
(define* (minify-build store name inputs
(define* (minify-build name inputs
#:key
source
(javascript-files #f)
(phases '(@ (guix build minify-build-system)
%standard-phases))
@ -84,38 +87,23 @@
(guix build utils))))
"Build SOURCE with INPUTS."
(define builder
`(begin
(use-modules ,@modules)
(minify-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:javascript-files ,javascript-files
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(minify-build #:name #$name
#:source #+source
#:javascript-files #$javascript-files
#:phases #$phases
#:outputs #$(outputs->gexp outputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs #$(input-tuples->gexp inputs)))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
(define minify-build-system
(build-system

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -20,7 +21,8 @@
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -55,7 +57,7 @@ registry."
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:node #:inputs #:native-inputs))
'(#:target #:node #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
@ -74,8 +76,9 @@ registry."
(build node-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (node-build store name inputs
(define* (node-build name inputs
#:key
source
(npm-flags ''())
(tests? #t)
(phases '(@ (guix build node-build-system)
@ -91,40 +94,25 @@ registry."
(guix build utils))))
"Build SOURCE using NODE and INPUTS."
(define builder
`(begin
(use-modules ,@modules)
(node-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:npm-flags ,npm-flags
#:tests? ,tests?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(node-build #:name #$name
#:source #+source
#:system #$system
#:npm-flags #$npm-flags
#:tests? #$tests?
#:phases #$phases
#:outputs #$(outputs->gexp outputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs #$(input-tuples->gexp inputs)))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
(define node-build-system
(build-system

View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2017 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -19,7 +20,7 @@
(define-module (guix build-system ocaml)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -206,7 +207,7 @@ pre-defined variants."
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:ocaml #:findlib #:inputs #:native-inputs))
'(#:target #:ocaml #:findlib #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
@ -226,8 +227,9 @@ pre-defined variants."
(build ocaml-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (ocaml-build store name inputs
#:key (guile #f)
(define* (ocaml-build name inputs
#:key
guile source
(outputs '("out")) (configure-flags ''())
(search-paths '())
(make-flags ''())
@ -253,51 +255,40 @@ pre-defined variants."
"Build SOURCE using OCAML, and with INPUTS. This assumes that SOURCE
provides a 'setup.ml' file as its build system."
(define builder
`(begin
(use-modules ,@modules)
(ocaml-build #:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:outputs %outputs
#:inputs %build-inputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:phases ,phases
#:configure-flags ,configure-flags
#:test-flags ,test-flags
#:make-flags ,make-flags
#:build-flags ,build-flags
#:out-of-source? ,out-of-source?
#:use-make? ,use-make?
#:tests? ,tests?
#:test-target ,test-target
#:install-target ,install-target
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(ocaml-build #:source #$source
#:system #$system
#:outputs (list #$@(map (lambda (name)
#~(cons #$name
(ungexp output name)))
outputs))
#:inputs (map (lambda (tuple)
(apply cons tuple))
'#$inputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:phases #$phases
#:configure-flags #$configure-flags
#:test-flags #$test-flags
#:make-flags #$make-flags
#:build-flags #$build-flags
#:out-of-source? #$out-of-source?
#:use-make? #$use-make?
#:tests? #$tests?
#:test-target #$test-target
#:install-target #$install-target
#:validate-runpath? #$validate-runpath?
#:patch-shebangs? #$patch-shebangs?
#:strip-binaries? #$strip-binaries?
#:strip-flags #$strip-flags
#:strip-directories #$strip-directories))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(gexp->derivation name builder
#:system system
#:target #f
#:guile-for-build guile))
(define ocaml-build-system
(build-system

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -19,6 +19,8 @@
(define-module (guix build-system perl)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix derivations)
#:use-module (guix search-paths)
#:use-module (guix build-system)
@ -57,7 +59,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:perl #:inputs #:native-inputs))
'(#:target #:perl #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
@ -76,8 +78,8 @@
(build perl-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (perl-build store name inputs
#:key
(define* (perl-build name inputs
#:key source
(search-paths '())
(tests? #t)
(parallel-build? #t)
@ -95,46 +97,34 @@
(guix build utils))))
"Build SOURCE using PERL, and with INPUTS. This assumes that SOURCE
provides a `Makefile.PL' file as its build system."
(define builder
`(begin
(use-modules ,@modules)
(perl-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:make-maker? ,make-maker?
#:make-maker-flags ,make-maker-flags
#:module-build-flags ,module-build-flags
#:phases ,phases
#:system ,system
#:test-target "test"
#:tests? ,tests?
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:outputs %outputs
#:inputs %build-inputs)))
(define build
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
#$(with-build-variables inputs outputs
#~(perl-build #:name #$name
#:source #+source
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:make-maker? #$make-maker?
#:make-maker-flags #$make-maker-flags
#:module-build-flags #$module-build-flags
#:phases #$phases
#:system #$system
#:test-target "test"
#:tests? #$tests?
#:parallel-build? #$parallel-build?
#:parallel-tests? #$parallel-tests?
#:outputs %outputs
#:inputs %build-inputs)))))
(build-expression->derivation store name builder
#:system system
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name build
#:system system
#:target #f
#:guile-for-build guile)))
(define perl-build-system
(build-system

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2021 Lars-Dominik Braun <lars@6xq.net>
@ -25,6 +25,8 @@
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix memoization)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix search-paths)
@ -147,7 +149,7 @@ pre-defined variants."
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:python #:inputs #:native-inputs))
'(#:target #:python #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
@ -167,8 +169,8 @@ pre-defined variants."
(build python-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (python-build store name inputs
#:key
(define* (python-build name inputs
#:key source
(tests? #t)
(test-target "test")
(use-setuptools? #t)
@ -184,43 +186,32 @@ pre-defined variants."
(guix build utils))))
"Build SOURCE using PYTHON, and with INPUTS. This assumes that SOURCE
provides a 'setup.py' file as its build system."
(define builder
`(begin
(use-modules ,@modules)
(python-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:configure-flags ,configure-flags
#:system ,system
#:test-target ,test-target
#:tests? ,tests?
#:use-setuptools? ,use-setuptools?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(define build
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
#$(with-build-variables inputs outputs
#~(python-build #:name #$name
#:source #+source
#:configure-flags #$configure-flags
#:use-setuptools? #$use-setuptools?
#:system #$system
#:test-target #$test-target
#:tests? #$tests?
#:phases #$phases
#:outputs %outputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name build
#:system system
#:target #f
#:guile-for-build guile)))
(define python-build-system
(build-system

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
@ -22,7 +22,8 @@
(define-module (guix build-system qt)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system cmake)
@ -71,7 +72,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
`(#:source #:cmake #:inputs #:native-inputs #:outputs
`(#:cmake #:inputs #:native-inputs #:outputs
,@(if target '() '(#:target))))
(bag
@ -105,8 +106,9 @@
(arguments (strip-keyword-arguments private-keywords arguments))))
(define* (qt-build store name inputs
#:key (guile #f)
(define* (qt-build name inputs
#:key
source (guile #f)
(outputs '("out")) (configure-flags ''())
(search-paths '())
(make-flags ''())
@ -131,60 +133,46 @@
"Build SOURCE using CMAKE, and with INPUTS. This assumes that SOURCE
provides a 'CMakeLists.txt' file as its build system."
(define builder
`(begin
(use-modules ,@modules)
(qt-build #:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:outputs %outputs
#:inputs %build-inputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:phases ,phases
#:qt-wrap-excluded-outputs ,qt-wrap-excluded-outputs
#:configure-flags ,configure-flags
#:make-flags ,make-flags
#:out-of-source? ,out-of-source?
#:build-type ,build-type
#:tests? ,tests?
#:test-target ,test-target
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(qt-build #:source #+source
#:system #$system
#:outputs #$(outputs->gexp outputs)
#:inputs #$(input-tuples->gexp inputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:phases #$phases
#:qt-wrap-excluded-outputs #$qt-wrap-excluded-outputs
#:configure-flags #$configure-flags
#:make-flags #$make-flags
#:out-of-source? #$out-of-source?
#:build-type #$build-type
#:tests? #$tests?
#:test-target #$test-target
#:parallel-build? #$parallel-build?
#:parallel-tests? #$parallel-tests?
#:validate-runpath? #$validate-runpath?
#:patch-shebangs? #$patch-shebangs?
#:strip-binaries? #$strip-binaries?
#:strip-flags #$strip-flags
#:strip-directories #$strip-directories))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
;;;
;;; Cross-compilation.
;;;
(define* (qt-cross-build store name
(define* (qt-cross-build name
#:key
target native-drvs target-drvs
source target
build-inputs target-inputs host-inputs
(guile #f)
(outputs '("out"))
(configure-flags ''())
@ -193,7 +181,7 @@ provides a 'CMakeLists.txt' file as its build system."
(make-flags ''())
(out-of-source? #t)
(build-type "RelWithDebInfo")
(tests? #f) ; nothing can be done
(tests? #f) ; nothing can be done
(test-target "test")
(parallel-build? #t) (parallel-tests? #f)
(validate-runpath? #t)
@ -214,77 +202,52 @@ provides a 'CMakeLists.txt' file as its build system."
with INPUTS. This assumes that SOURCE provides a 'CMakeLists.txt' file as its
build system."
(define builder
`(begin
(use-modules ,@modules)
(let ()
(define %build-host-inputs
',(map (match-lambda
((name (? derivation? drv) sub ...)
`(,name . ,(apply derivation->output-path drv sub)))
((name path)
`(,name . ,path)))
native-drvs))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(define %build-target-inputs
',(map (match-lambda
((name (? derivation? drv) sub ...)
`(,name . ,(apply derivation->output-path drv sub)))
((name (? package? pkg) sub ...)
(let ((drv (package-cross-derivation store pkg
target system)))
`(,name . ,(apply derivation->output-path drv sub))))
((name path)
`(,name . ,path)))
target-drvs))
(define %build-host-inputs
#+(input-tuples->gexp build-inputs))
(qt-build #:source ,(match (assoc-ref native-drvs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:build ,build
#:target ,target
#:outputs %outputs
#:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:native-search-paths ',(map
search-path-specification->sexp
native-search-paths)
#:phases ,phases
#:configure-flags ,configure-flags
#:make-flags ,make-flags
#:out-of-source? ,out-of-source?
#:build-type ,build-type
#:tests? ,tests?
#:test-target ,test-target
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories))))
(define %build-target-inputs
(append #$(input-tuples->gexp host-inputs)
#+(input-tuples->gexp target-inputs)))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(define %outputs
#$(outputs->gexp outputs))
(build-expression->derivation store name builder
#:system system
#:inputs (append native-drvs target-drvs)
#:outputs outputs
#:modules imported-modules
#:guile-for-build guile-for-build))
(qt-build #:source #+source
#:system #$system
#:build #$build
#:target #$target
#:outputs %outputs
#:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:native-search-paths '#$(map
search-path-specification->sexp
native-search-paths)
#:phases #$phases
#:configure-flags #$configure-flags
#:make-flags #$make-flags
#:out-of-source? #$out-of-source?
#:build-type #$build-type
#:tests? #$tests?
#:test-target #$test-target
#:parallel-build? #$parallel-build?
#:parallel-tests? #$parallel-tests?
#:validate-runpath? #$validate-runpath?
#:patch-shebangs? #$patch-shebangs?
#:strip-binaries? #$strip-binaries?
#:strip-flags #$strip-flags
#:strip-directories #$strip-directories))))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
(define qt-build-system
(build-system

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -20,7 +21,8 @@
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -82,7 +84,7 @@ release corresponding to NAME and VERSION."
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:r #:inputs #:native-inputs))
'(#:target #:r #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
@ -101,8 +103,9 @@ release corresponding to NAME and VERSION."
(build r-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (r-build store name inputs
(define* (r-build name inputs
#:key
source
(tests? #t)
(test-target "tests")
(configure-flags ''())
@ -118,42 +121,27 @@ release corresponding to NAME and VERSION."
(guix build utils))))
"Build SOURCE with INPUTS."
(define builder
`(begin
(use-modules ,@modules)
(r-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:configure-flags ,configure-flags
#:system ,system
#:tests? ,tests?
#:test-target ,test-target
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(r-build #:name #$name
#:source #+source
#:configure-flags #$configure-flags
#:system #$system
#:tests? #$tests?
#:test-target #$test-target
#:phases #$phases
#:outputs #$(outputs->gexp outputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs #$(input-tuples->gexp inputs)))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build
#:substitutable? substitutable?))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile
#:substitutable? substitutable?)))
(define r-build-system
(build-system

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -19,7 +20,8 @@
(define-module (guix build-system rakudo)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -71,7 +73,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:rakudo #:prove6 #:zef #:inputs #:native-inputs))
'(#:target #:rakudo #:prove6 #:zef #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
@ -96,8 +98,9 @@
(build rakudo-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (rakudo-build store name inputs
(define* (rakudo-build name inputs
#:key
source
(search-paths '())
(tests? #t)
(phases '(@ (guix build rakudo-build-system)
@ -112,39 +115,24 @@
(guix build utils))))
"Build SOURCE using PERL6, and with INPUTS."
(define builder
`(begin
(use-modules ,@modules)
(rakudo-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:phases ,phases
#:system ,system
#:tests? ,tests?
#:outputs %outputs
#:inputs %build-inputs)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(rakudo-build #:name #$name
#:source #+source
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:phases #$phases
#:system #$system
#:tests? #$tests?
#:outputs #$(outputs->gexp outputs)
#:inputs #$(input-tuples->gexp inputs)))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
(define rakudo-build-system
(build-system

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Leo Prikler <leo.prikler@student.tugraz.at>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -21,7 +22,8 @@
#:use-module (guix utils)
#:use-module (guix memoization)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -53,7 +55,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:renpy #:inputs #:native-inputs))
'(#:target #:renpy #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
@ -72,57 +74,43 @@
(build renpy-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (renpy-build store name inputs
#:key
(phases '(@ (guix build renpy-build-system)
%standard-phases))
(configure-flags ''())
(outputs '("out"))
(output "out")
(game "game")
(search-paths '())
(system (%current-system))
(guile #f)
(imported-modules %renpy-build-system-modules)
(modules '((guix build renpy-build-system)
(guix build utils))))
(define* (renpy-build name inputs
#:key
source
(phases '(@ (guix build renpy-build-system)
%standard-phases))
(configure-flags ''())
(outputs '("out"))
(output "out")
(game "game")
(search-paths '())
(system (%current-system))
(guile #f)
(imported-modules %renpy-build-system-modules)
(modules '((guix build renpy-build-system)
(guix build utils))))
"Build SOURCE using RENPY, and with INPUTS."
(define builder
`(begin
(use-modules ,@modules)
(renpy-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:configure-flags ,configure-flags
#:system ,system
#:phases ,phases
#:outputs %outputs
#:output ,output
#:game ,game
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(renpy-build #:name #$name
#:source #+source
#:configure-flags #$configure-flags
#:system #$system
#:phases #$phases
#:outputs #$(outputs->gexp outputs)
#:output #$output
#:game #$game
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs #$(input-tuples->gexp inputs)))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
(define renpy-build-system
(build-system

View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015, 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -20,6 +20,8 @@
(define-module (guix build-system ruby)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix search-paths)
@ -54,7 +56,7 @@ NAME and VERSION."
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:ruby #:inputs #:native-inputs))
'(#:target #:ruby #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
@ -73,8 +75,8 @@ NAME and VERSION."
(build ruby-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (ruby-build store name inputs
#:key
(define* (ruby-build name inputs
#:key source
(gem-flags ''())
(test-target "test")
(tests? #t)
@ -88,42 +90,30 @@ NAME and VERSION."
(modules '((guix build ruby-build-system)
(guix build utils))))
"Build SOURCE using RUBY and INPUTS."
(define builder
`(begin
(use-modules ,@modules)
(ruby-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:gem-flags ,gem-flags
#:test-target ,test-target
#:tests? ,tests?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(define build
#~(begin
(use-modules #$@modules)
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
#$(with-build-variables inputs outputs
#~(ruby-build #:name #$name
#:source #+source
#:system #$system
#:gem-flags #$gem-flags
#:test-target #$test-target
#:tests? #$tests?
#:phases #$phases
#:outputs %outputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name build
#:system system
#:target #f
#:modules imported-modules
#:guile-for-build guile)))
(define ruby-build-system
(build-system

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -19,7 +20,8 @@
(define-module (guix build-system scons)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix monads)
#:use-module (guix gexp)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -53,7 +55,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:scons #:inputs #:native-inputs))
'(#:target #:scons #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
@ -72,8 +74,9 @@
(build scons-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (scons-build store name inputs
(define* (scons-build name inputs
#:key
(source #f)
(tests? #t)
(scons-flags ''())
(build-targets ''())
@ -91,43 +94,33 @@
"Build SOURCE using SCons, and with INPUTS. This assumes that SOURCE
provides a 'SConstruct' file as its build system."
(define builder
`(begin
(use-modules ,@modules)
(scons-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:scons-flags ,scons-flags
#:system ,system
#:build-targets ,build-targets
#:test-target ,test-target
#:tests? ,tests?
#:install-targets ,install-targets
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(scons-build #:name ,name
#:source #+source
#:scons-flags #$scons-flags
#:system #$system
#:build-targets #$build-targets
#:test-target #$test-target
#:tests? #$tests?
#:install-targets #$install-targets
#:phases #$phases
#:outputs (list #$@(map (lambda (name)
#~(cons #$name
(ungexp output name)))
outputs))
#:inputs (map (lambda (tuple)
(apply cons tuple))
'#$inputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(gexp->derivation name builder
#:system system
#:target #f
#:guile-for-build guile))
(define scons-build-system
(build-system

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -20,7 +21,8 @@
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix monads)
#:use-module (guix gexp)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@ -100,7 +102,7 @@ level package ID."
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:inputs #:native-inputs
'(#:target #:inputs #:native-inputs
#:texlive-latex-base #:texlive-bin))
(bag
@ -120,8 +122,9 @@ level package ID."
(build texlive-build)
(arguments (strip-keyword-arguments private-keywords arguments))))
(define* (texlive-build store name inputs
(define* (texlive-build name inputs
#:key
source
(tests? #f)
tex-directory
(build-targets #f)
@ -139,43 +142,31 @@ level package ID."
(guix build utils))))
"Build SOURCE with INPUTS."
(define builder
`(begin
(use-modules ,@modules)
(texlive-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:tex-directory ,tex-directory
#:build-targets ,build-targets
#:tex-format ,tex-format
#:system ,system
#:tests? ,tests?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(with-imported-modules imported-modules
#~(begin
(use-modules #$@modules)
(texlive-build #:name #$name
#:source #+source
#:tex-directory #$tex-directory
#:build-targets #$build-targets
#:tex-format #$tex-format
#:system #$system
#:tests? #$tests?
#:phases #$phases
#:outputs (list #$@(map (lambda (name)
#~(cons #$name
(ungexp output name)))
outputs))
#:inputs (map (lambda (tuple)
(apply cons tuple))
'#$inputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build
#:substitutable? substitutable?))
(gexp->derivation name builder
#:system system
#:target #f
#:substitutable? substitutable?))
(define texlive-build-system
(build-system

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2018, 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -19,24 +19,16 @@
(define-module (guix build-system trivial)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix build-system)
#:use-module (ice-9 match)
#:export (trivial-build-system))
(define (guile-for-build store guile system)
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(define* (lower name
#:key source inputs native-inputs outputs system target
guile builder modules allowed-references)
guile builder (modules '()) allowed-references)
"Return a bag for NAME."
(bag
(name name)
@ -54,65 +46,42 @@
#:modules ,modules
#:allowed-references ,allowed-references))))
(define* (trivial-build store name inputs
(define* (trivial-build name inputs
#:key
outputs guile system builder (modules '())
outputs guile
system builder (modules '())
search-paths allowed-references)
"Run build expression BUILDER, an expression, for SYSTEM. SOURCE is
ignored."
(define canonicalize-reference
(match-lambda
((? package? p)
(derivation->output-path (package-derivation store p system
#:graft? #f)))
(((? package? p) output)
(derivation->output-path (package-derivation store p system
#:graft? #f)
output))
((? string? output)
output)))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name (with-build-variables inputs outputs builder)
#:system system
#:target #f
#:modules modules
#:allowed-references allowed-references
#:guile-for-build guile)))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:outputs outputs
#:modules modules
#:allowed-references
(and allowed-references
(map canonicalize-reference
allowed-references))
#:guile-for-build
(guile-for-build store guile system)))
(define* (trivial-cross-build store name
(define* (trivial-cross-build name
#:key
target native-drvs target-drvs
target
source build-inputs target-inputs host-inputs
outputs guile system builder (modules '())
search-paths native-search-paths
allowed-references)
"Run build expression BUILDER, an expression, for SYSTEM. SOURCE is
ignored."
(define canonicalize-reference
(match-lambda
((? package? p)
(derivation->output-path (package-cross-derivation store p system)))
(((? package? p) output)
(derivation->output-path (package-cross-derivation store p system)
output))
((? string? output)
output)))
(build-expression->derivation store name builder
#:inputs (append native-drvs target-drvs)
#:system system
#:outputs outputs
#:modules modules
#:allowed-references
(and allowed-references
(map canonicalize-reference
allowed-references))
#:guile-for-build
(guile-for-build store guile system)))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name (with-build-variables
(append build-inputs target-inputs)
outputs
builder)
#:system system
#:target target
#:modules modules
#:allowed-references allowed-references
#:guile-for-build guile)))
(define trivial-build-system
(build-system

View File

@ -19,6 +19,8 @@
(define-module (guix build-system waf)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix search-paths)
@ -52,7 +54,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:python #:inputs #:native-inputs))
'(#:target #:python #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
@ -71,58 +73,46 @@
(build waf-build) ; only change compared to 'lower' in python.scm
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (waf-build store name inputs
#:key
(tests? #t)
(test-target "check")
(configure-flags ''())
(phases '(@ (guix build waf-build-system)
%standard-phases))
(outputs '("out"))
(search-paths '())
(system (%current-system))
(guile #f)
(imported-modules %waf-build-system-modules)
(modules '((guix build waf-build-system)
(guix build utils))))
(define* (waf-build name inputs
#:key source
(tests? #t)
(test-target "check")
(configure-flags ''())
(phases '(@ (guix build waf-build-system)
%standard-phases))
(outputs '("out"))
(search-paths '())
(system (%current-system))
(guile #f)
(imported-modules %waf-build-system-modules)
(modules '((guix build waf-build-system)
(guix build utils))))
"Build SOURCE with INPUTS. This assumes that SOURCE provides a 'waf' file
as its build system."
(define builder
`(begin
(use-modules ,@modules)
(waf-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:configure-flags ,configure-flags
#:system ,system
#:test-target ,test-target
#:tests? ,tests?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(define build
#~(begin
(use-modules #$@modules)
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
#$(with-build-variables inputs outputs
#~(waf-build #:name #$name
#:source #+source
#:configure-flags #$configure-flags
#:system #$system
#:test-target #$test-target
#:tests? #$tests?
#:phases #$phases
#:outputs %outputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name build
#:system system
#:target #f
#:modules imported-modules
#:guile-for-build guile)))
(define waf-build-system
(build-system

View File

@ -112,6 +112,7 @@
mixed-text-file
file-union
directory-union
imported-files
imported-modules
compiled-modules

View File

@ -1174,10 +1174,6 @@ matching package and returns a replacement for that package."
;;; Package derivations.
;;;
(define %derivation-cache
;; Package to derivation-path mapping.
(make-weak-key-hash-table 100))
(define (cache! cache package system thunk)
"Memoize in CACHE the return values of THUNK as the derivation of PACKAGE on
SYSTEM."
@ -1209,48 +1205,29 @@ Return the cached result when available."
((_ package system body ...)
(cached (=> %derivation-cache) package system body ...))))
(define* (expand-input store package input system #:optional cross-system)
"Expand INPUT, an input tuple, such that it contains only references to
derivation paths or store paths. PACKAGE is only used to provide contextual
information in exceptions."
(define (intern file)
;; Add FILE to the store. Set the `recursive?' bit to #t, so that
;; file permissions are preserved.
(add-to-store store (basename file) #t "sha256" file))
(define derivation
(if cross-system
(cut package-cross-derivation store <> cross-system system
#:graft? #f)
(cut package-derivation store <> system #:graft? #f)))
(define* (expand-input package input #:key native?)
"Expand INPUT, an input tuple, to a name/<gexp-input> tuple. PACKAGE is
only used to provide contextual information in exceptions."
(define (valid? x)
(or (package? x) (origin? x) (derivation? x)))
(match input
(((? string? name) (? package? package))
(list name (derivation package)))
(((? string? name) (? package? package)
(? string? sub-drv))
(list name (derivation package)
sub-drv))
(((? string? name)
(and (? string?) (? derivation-path?) drv))
(list name drv))
(((? string? name) (? valid? thing))
(list name (gexp-input thing #:native? native?)))
(((? string? name) (? valid? thing) (? string? output))
(list name (gexp-input thing output #:native? native?)))
(((? string? name)
(and (? string?) (? file-exists? file)))
;; Add FILE to the store. When FILE is in the sub-directory of a
;; store path, it needs to be added anyway, so it can be used as a
;; source.
(list name (intern file)))
(list name (gexp-input (local-file file #:recursive? #t)
#:native? native?)))
(((? string? name) (? struct? source))
;; 'package-source-derivation' calls 'lower-object', which can throw
;; '&gexp-input-error'. However '&gexp-input-error' lacks source
;; location info, so we catch and rethrow here (XXX: not optimal
;; performance-wise).
(guard (c ((gexp-input-error? c)
(raise (condition
(&package-input-error
(package package)
(input (gexp-error-invalid-input c)))))))
(list name (package-source-derivation store source system))))
;; location info, so we used to catch and rethrow here (FIXME!).
(list name (gexp-input source)))
(x
(raise (condition (&package-input-error
(package package)
@ -1434,12 +1411,14 @@ TARGET."
(define (input=? input1 input2)
"Return true if INPUT1 and INPUT2 are equivalent."
(match input1
((label1 drv1 . outputs1)
((label1 obj1 . outputs1)
(match input2
((label2 drv2 . outputs2)
((label2 obj2 . outputs2)
(and (string=? label1 label2)
(equal? outputs1 outputs2)
(derivation=? drv1 drv2)))))))
(or (and (derivation? obj1) (derivation? obj2)
(derivation=? obj1 obj2))
(equal? obj1 obj2))))))))
(define* (bag->derivation store bag
#:optional context)
@ -1450,7 +1429,7 @@ error reporting."
(bag->cross-derivation store bag)
(let* ((system (bag-system bag))
(inputs (bag-transitive-inputs bag))
(input-drvs (map (cut expand-input store context <> system)
(input-drvs (map (cut expand-input context <> #:native? #t)
inputs))
(paths (delete-duplicates
(append-map (match-lambda
@ -1462,7 +1441,8 @@ error reporting."
;; It's possible that INPUTS contains packages that are not 'eq?' but
;; that lead to the same derivation. Delete those duplicates to avoid
;; issues down the road, such as duplicate entries in '%build-inputs'.
(apply (bag-build bag)
;; TODO: Change to monadic style.
(apply (store-lower (bag-build bag))
store (bag-name bag)
(delete-duplicates input-drvs input=?)
#:search-paths paths
@ -1477,13 +1457,13 @@ This is an internal procedure."
(let* ((system (bag-system bag))
(target (bag-target bag))
(host (bag-transitive-host-inputs bag))
(host-drvs (map (cut expand-input store context <> system target)
(host-drvs (map (cut expand-input context <> #:native? #f)
host))
(target* (bag-transitive-target-inputs bag))
(target-drvs (map (cut expand-input store context <> system)
(target-drvs (map (cut expand-input context <> #:native? #t)
target*))
(build (bag-transitive-build-inputs bag))
(build-drvs (map (cut expand-input store context <> system)
(build-drvs (map (cut expand-input context <> #:native? #t)
build))
(all (append build target* host))
(paths (delete-duplicates
@ -1500,11 +1480,12 @@ This is an internal procedure."
(_ '()))
all))))
(apply (bag-build bag)
;; TODO: Change to monadic style.
(apply (store-lower (bag-build bag))
store (bag-name bag)
#:native-drvs (delete-duplicates build-drvs input=?)
#:target-drvs (delete-duplicates (append host-drvs target-drvs)
input=?)
#:build-inputs (delete-duplicates build-drvs input=?)
#:host-inputs (delete-duplicates host-drvs input=?)
#:target-inputs (delete-duplicates target-drvs input=?)
#:search-paths paths
#:native-search-paths npaths
#:outputs (bag-outputs bag)

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2021 Lars-Dominik Braun <lars@6xq.net>
;;;
;;; This file is part of GNU Guix.

View File

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
@ -432,7 +432,7 @@
(single-lint-warning-message (check-patch-headers pkg)))))
(test-equal "derivation: invalid arguments"
"failed to create x86_64-linux derivation: (wrong-type-arg \"map\" \"Wrong type argument: ~S\" (invalid-module) ())"
"failed to create x86_64-linux derivation: (match-error \"match\" \"no matching pattern\" invalid-module)"
(match (let ((pkg (dummy-package "x"
(arguments
'(#:imported-modules (invalid-module))))))

View File

@ -868,9 +868,9 @@
(system system) (target target)
(build-inputs inputs)
(build
(lambda* (store name inputs
#:key outputs system search-paths)
search-paths)))))))
(lambda* (name inputs
#:key outputs system search-paths)
(abort-to-prompt p search-paths))))))))
(x (list (search-path-specification
(variable "GUILE_LOAD_PATH")
(files '("share/guile/site/2.0")))
@ -1170,11 +1170,11 @@
(bag (name name) (system system) (target target)
(build-inputs native-inputs)
(host-inputs inputs)
(build (lambda* (store name inputs
#:key system target
#:allow-other-keys)
(build-expression->derivation
store "foo" '(mkdir %output))))))))
(build (lambda* (name inputs
#:key system target
#:allow-other-keys)
(gexp->derivation "foo"
#~(mkdir #$output))))))))
(bs (build-system
(name 'build-system-without-cross-compilation)
(description "Does not support cross compilation.")