amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

build-system: Rewrite using gexps.

Browse source 
* 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
Download patch file Download diff file Expand all files Collapse all files

1
.dir-locals.el
View file

@ -119,6 +119,7 @@
(eval . (put 'with-extensions 'scheme-indent-function 1)) (eval . (put 'with-extensions 'scheme-indent-function 1))
(eval . (put 'with-parameters 'scheme-indent-function 1)) (eval . (put 'with-parameters 'scheme-indent-function 1))
(eval . (put 'let-system '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 'with-database 'scheme-indent-function 2))
(eval . (put 'call-with-database 'scheme-indent-function 1)) (eval . (put 'call-with-database 'scheme-indent-function 1))

47
gnu/packages/bootstrap.scm
View file

@ -32,11 +32,13 @@
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (guix build-system trivial) #:use-module (guix build-system trivial)
#:use-module ((guix store) #: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) #:use-module ((guix derivations)
#:select (derivation derivation-input derivation->output-path)) #:select (raw-derivation derivation-input derivation->output-path))
#:use-module ((guix utils) #:select (gnu-triplet->nix-system)) #:use-module (guix utils)
#:use-module ((guix build utils) #:select (elf-file?))
#:use-module ((guix gexp) #:select (lower-object)) #:use-module ((guix gexp) #:select (lower-object))
#:use-module (guix monads)
#:use-module (guix memoization) #:use-module (guix memoization)
#:use-module (guix i18n) #:use-module (guix i18n)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -376,33 +378,26 @@ or false to signal an error."
%bootstrap-base-urls)) %bootstrap-base-urls))
(sha256 (bootstrap-guile-hash system)))) (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." "Return a derivation that downloads the bootstrap Guile tarball for SYSTEM."
(let* ((path (bootstrap-guile-url-path system)) (let* ((path (bootstrap-guile-url-path system))
(base (basename path)) (base (basename path))
(urls (map (cut string-append <> path) %bootstrap-base-urls))) (urls (map (cut string-append <> path) %bootstrap-base-urls)))
(run-with-store store
(url-fetch urls 'sha256 (bootstrap-guile-hash system) (url-fetch urls 'sha256 (bootstrap-guile-hash system)
#:system system)))) #:system system)))
(define* (raw-build store name inputs (define* (raw-build name inputs
#:key outputs system search-paths #:key outputs system search-paths
#:allow-other-keys) #:allow-other-keys)
(define (->store file) (define (->store file)
(run-with-store store
(lower-object (bootstrap-executable file system) (lower-object (bootstrap-executable file system)
system))) system))
(let* ((tar (->store "tar")) (define (make-guile-wrapper bash guile-real)
(xz (->store "xz")) ;; The following code, run by the bootstrap guile after it is unpacked,
(mkdir (->store "mkdir")) ;; creates a wrapper for itself to set its load path. This replaces the
(bash (->store "bash")) ;; previous non-portable method based on reading the /proc/self/exe
(guile (download-bootstrap-guile store system)) ;; symlink.
;; 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 '(begin
(use-modules (ice-9 match)) (use-modules (ice-9 match))
(match (command-line) (match (command-line)
@ -425,9 +420,15 @@ exec -a \"~a0\" ~a \"~a@\"\n"
bash out out dollar guile-real dollar))) bash out out dollar guile-real dollar)))
(chmod guile #o555) (chmod guile #o555)
(chmod bin-dir #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 (builder
(add-text-to-store store (text-file "build-bootstrap-guile.sh"
"build-bootstrap-guile.sh"
(format #f " (format #f "
echo \"unpacking bootstrap Guile to '$out'...\" echo \"unpacking bootstrap Guile to '$out'...\"
~a $out ~a $out
@ -444,9 +445,9 @@ $out/bin/guile --version~%"
(derivation->output-path mkdir) (derivation->output-path mkdir)
(derivation->output-path xz) (derivation->output-path xz)
(derivation->output-path tar) (derivation->output-path tar)
(format #f "~s" make-guile-wrapper) (object->string wrapper)
(derivation->output-path bash))))) (derivation->output-path bash)))))
(derivation store name (raw-derivation name
(derivation->output-path bash) `(,builder) (derivation->output-path bash) `(,builder)
#:system system #:system system
#:inputs (map derivation-input #:inputs (map derivation-input

3
gnu/packages/commencement.scm
View file

@ -52,6 +52,7 @@
#:use-module (gnu packages pkg-config) #:use-module (gnu packages pkg-config)
#:use-module (gnu packages rsync) #:use-module (gnu packages rsync)
#:use-module (gnu packages xml) #:use-module (gnu packages xml)
#:use-module (guix gexp)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix build-system gnu) #: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. ;; if 'allowed-references' were per-output.
(arguments (arguments
`(#:allowed-references `(#:allowed-references
((,gcc-boot0 "lib") (,(gexp-input gcc-boot0 "lib")
,(kernel-headers-boot0) ,(kernel-headers-boot0)
,static-bash-for-glibc ,static-bash-for-glibc
,@(if (hurd-system?) ,@(if (hurd-system?)

69
guix/build-system/android-ndk.scm
View file

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

74
guix/build-system/ant.scm
View file

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

104
guix/build-system/asdf.scm
View file

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca> ;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
;;; Copyright © 2019, 2020 Guillaume Le Vaillant <glv@posteo.net> ;;; Copyright © 2019, 2020 Guillaume Le Vaillant <glv@posteo.net>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -22,7 +23,8 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix memoization) #:use-module (guix memoization)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix derivations) #:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix search-paths) #:use-module (guix search-paths)
#:use-module ((guix build utils) #:use-module ((guix build utils)
#:select ((package-name->name+version #:select ((package-name->name+version
@ -92,7 +94,7 @@
(build asdf-build/source) (build asdf-build/source)
(arguments (strip-keyword-arguments private-keywords arguments))))) (arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (asdf-build/source store name inputs (define* (asdf-build/source name inputs
#:key source outputs #:key source outputs
(phases '(@ (guix build asdf-build-system) (phases '(@ (guix build asdf-build-system)
%standard-phases/source)) %standard-phases/source))
@ -102,36 +104,23 @@
(imported-modules %asdf-build-system-modules) (imported-modules %asdf-build-system-modules)
(modules %asdf-build-modules)) (modules %asdf-build-modules))
(define builder (define builder
`(begin (with-imported-modules imported-modules
(use-modules ,@modules) #~(begin
(asdf-build/source #:name ,name (use-modules #$@modules)
#:source ,(match (assoc-ref inputs "source") (asdf-build/source #:name #$name
(((? derivation? source)) #:source #+source
(derivation->output-path source)) #:system #$system
((source) source) #:phases #$phases
(source source)) #:outputs #$(outputs->gexp outputs)
#:system ,system #:search-paths '#$(map search-path-specification->sexp
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths) search-paths)
#:inputs %build-inputs))) #:inputs #$(input-tuples->gexp inputs)))))
(define guile-for-build (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
(match guile system #:graft? #f)))
((? package?) (gexp->derivation name builder
(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 #:system system
#:modules imported-modules #:guile-for-build guile)))
#:outputs outputs
#:guile-for-build guile-for-build))
(define* (package-with-build-system from-build-system to-build-system (define* (package-with-build-system from-build-system to-build-system
from-prefix to-prefix from-prefix to-prefix
@ -277,7 +266,7 @@ set up using CL source package conventions."
(arguments (strip-keyword-arguments private-keywords arguments)))))) (arguments (strip-keyword-arguments private-keywords arguments))))))
(define (asdf-build lisp-type) (define (asdf-build lisp-type)
(lambda* (store name inputs (lambda* (name inputs
#:key source outputs #:key source outputs
(tests? #t) (tests? #t)
(asd-files ''()) (asd-files ''())
@ -304,44 +293,31 @@ set up using CL source package conventions."
asd-systems)) asd-systems))
(define builder (define builder
`(begin (with-imported-modules imported-modules
(use-modules ,@modules) #~(begin
(use-modules #$@modules)
(parameterize ((%lisp (string-append (parameterize ((%lisp (string-append
(assoc-ref %build-inputs ,lisp-type) (assoc-ref %build-inputs #$lisp-type)
"/bin/" ,lisp-type)) "/bin/" #$lisp-type))
(%lisp-type ,lisp-type)) (%lisp-type #$lisp-type))
(asdf-build #:name ,name (asdf-build #:name #$name
#:source ,(match (assoc-ref inputs "source") #:source #+source
(((? derivation? source)) #:asd-files #$asd-files
(derivation->output-path source)) #:asd-systems #$systems
((source) source) #:test-asd-file #$test-asd-file
(source source)) #:system #$system
#:asd-files ,asd-files #:tests? #$tests?
#:asd-systems ,systems #:phases #$phases
#:test-asd-file ,test-asd-file #:outputs #$(outputs->gexp outputs)
#:system ,system #:search-paths '#$(map search-path-specification->sexp
#:tests? ,tests?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths) search-paths)
#:inputs %build-inputs)))) #:inputs #$(input-tuples->gexp inputs))))))
(define guile-for-build (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
(match guile system #:graft? #f)))
((? package?) (gexp->derivation name builder
(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 #:system system
#:modules imported-modules #:guile-for-build guile))))
#:outputs outputs
#:guile-for-build guile-for-build)))
(define asdf-build-system/sbcl (define asdf-build-system/sbcl
(build-system (build-system

76
guix/build-system/cargo.scm
View file

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

62
guix/build-system/chicken.scm
View file

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

89
guix/build-system/clojure.scm
View file

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

185
guix/build-system/cmake.scm
View file

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

66
guix/build-system/copy.scm
View file

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

59
guix/build-system/dub.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2016 David Craven <david@craven.ch>
@ -24,7 +24,8 @@
#:use-module (guix search-paths) #:use-module (guix search-paths)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix derivations) #:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix build-system) #:use-module (guix build-system)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
@ -56,8 +57,9 @@
(guix build syscalls) (guix build syscalls)
,@%gnu-build-system-modules)) ,@%gnu-build-system-modules))
(define* (dub-build store name inputs (define* (dub-build name inputs
#:key #:key
source
(tests? #t) (tests? #t)
(test-target #f) (test-target #f)
(dub-build-flags ''()) (dub-build-flags ''())
@ -72,41 +74,26 @@
(guix build utils)))) (guix build utils))))
"Build SOURCE using DUB, and with INPUTS." "Build SOURCE using DUB, and with INPUTS."
(define builder (define builder
`(begin (with-imported-modules imported-modules
(use-modules ,@modules) #~(begin
(dub-build #:name ,name (use-modules #$@modules)
#:source ,(match (assoc-ref inputs "source") (dub-build #:name #$name
(((? derivation? source)) #:source #+source
(derivation->output-path source)) #:system #$system
((source) #:test-target #$test-target
source) #:dub-build-flags #$dub-build-flags
(source #:tests? #$tests?
source)) #:phases #$phases
#:system ,system #:outputs #$(outputs->gexp outputs)
#:test-target ,test-target #:search-paths '#$(map search-path-specification->sexp
#:dub-build-flags ,dub-build-flags
#:tests? ,tests?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths) search-paths)
#:inputs %build-inputs))) #:inputs #$(input-tuples->gexp inputs)))))
(define guile-for-build (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
(match guile system #:graft? #f)))
((? package?) (gexp->derivation name builder
(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 #:system system
#:modules imported-modules #:guile-for-build guile)))
#:outputs outputs
#:guile-for-build guile-for-build))
(define* (lower name (define* (lower name
#:key source inputs native-inputs outputs system target #:key source inputs native-inputs outputs system target
@ -118,7 +105,7 @@
"Return a bag for NAME." "Return a bag for NAME."
(define private-keywords (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 (and (not target) ;; TODO: support cross-compilation
(bag (bag

81
guix/build-system/dune.scm
View file

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

58
guix/build-system/emacs.scm
View file

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

55
guix/build-system/font.scm
View file

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

95
guix/build-system/glib-or-gtk.scm
View file

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

248
guix/build-system/gnu.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -20,6 +20,8 @@
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix memoization) #:use-module (guix memoization)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix search-paths) #:use-module (guix search-paths)
#:use-module (guix build-system) #:use-module (guix build-system)
@ -281,7 +283,7 @@ standard packages used as implicit inputs of the GNU build system."
#:rest arguments) #:rest arguments)
"Return a bag for NAME from the given arguments." "Return a bag for NAME from the given arguments."
(define private-keywords (define private-keywords
`(#:source #:inputs #:native-inputs #:outputs `(#:inputs #:native-inputs #:outputs
#:implicit-inputs? #:implicit-cross-inputs? #:implicit-inputs? #:implicit-cross-inputs?
,@(if target '() '(#:target)))) ,@(if target '() '(#:target))))
@ -328,8 +330,9 @@ standard packages used as implicit inputs of the GNU build system."
;; Typical names of Autotools "bootstrap" scripts. ;; Typical names of Autotools "bootstrap" scripts.
'("bootstrap" "bootstrap.sh" "autogen.sh")) '("bootstrap" "bootstrap.sh" "autogen.sh"))
(define* (gnu-build store name input-drvs (define* (gnu-build name inputs
#:key (guile #f) #:key
guile source
(outputs '("out")) (outputs '("out"))
(search-paths '()) (search-paths '())
(bootstrap-scripts (list 'quote %bootstrap-scripts)) (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. returned derivations, or whether they should always build it locally.
ALLOWED-REFERENCES can be either #f, or a list of packages that the outputs 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 are allowed to refer to."
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)))
(define builder (define builder
`(begin (with-imported-modules imported-modules
(use-modules ,@modules) #~(begin
(gnu-build #:source ,(match (assoc-ref input-drvs "source") (use-modules #$@modules)
(((? derivation? source))
(derivation->output-path source)) #$(with-build-variables inputs outputs
((source) #~(gnu-build #:source #+source
source) #:system #$system
(source #:build #$build
source))
#:system ,system
#:build ,build
#:outputs %outputs #:outputs %outputs
#:inputs %build-inputs #:inputs %build-inputs
#:search-paths ',(map search-path-specification->sexp #:search-paths '#$(map search-path-specification->sexp
search-paths) search-paths)
#:phases ,phases #:phases #$phases
#:locale ,locale #:locale #$locale
#:bootstrap-scripts ,bootstrap-scripts #:bootstrap-scripts #$bootstrap-scripts
#:configure-flags ,configure-flags #:configure-flags #$configure-flags
#:make-flags ,make-flags #:make-flags #$make-flags
#:out-of-source? ,out-of-source? #:out-of-source? #$out-of-source?
#:tests? ,tests? #:tests? #$tests?
#:test-target ,test-target #:test-target #$test-target
#:parallel-build? ,parallel-build? #:parallel-build? #$parallel-build?
#:parallel-tests? ,parallel-tests? #:parallel-tests? #$parallel-tests?
#:patch-shebangs? ,patch-shebangs? #:patch-shebangs? #$patch-shebangs?
#:strip-binaries? ,strip-binaries? #:license-file-regexp #$license-file-regexp
#:validate-runpath? ,validate-runpath? #:strip-binaries? #$strip-binaries?
#:make-dynamic-linker-cache? ,make-dynamic-linker-cache? #:validate-runpath? #$validate-runpath?
#:license-file-regexp ,license-file-regexp #:make-dynamic-linker-cache? #$make-dynamic-linker-cache?
#:strip-flags ,strip-flags #:license-file-regexp #$license-file-regexp
#:strip-directories ,strip-directories))) #:strip-flags #$strip-flags
#:strip-directories #$strip-directories)))))
(define guile-for-build (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
(match guile system #:graft? #f)))
((? package?) (gexp->derivation name builder
(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 #:system system
#:inputs input-drvs #:target #f
#:outputs outputs
#:modules imported-modules
#:substitutable? substitutable? #:substitutable? substitutable?
#:allowed-references allowed-references
#:allowed-references #:disallowed-references disallowed-references
(and allowed-references #:guile-for-build guile)))
(map canonicalize-reference
allowed-references))
#:disallowed-references
(and disallowed-references
(map canonicalize-reference
disallowed-references))
#:guile-for-build guile-for-build))
;;; ;;;
@ -483,11 +454,11 @@ is one of `host' or `target'."
`(("cross-libc:static" ,libc "static")) `(("cross-libc:static" ,libc "static"))
'())))))))) '()))))))))
(define* (gnu-cross-build store name (define* (gnu-cross-build name
#:key #:key
target native-drvs target-drvs target
(guile #f) build-inputs target-inputs host-inputs
source guile source
(outputs '("out")) (outputs '("out"))
(search-paths '()) (search-paths '())
(native-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-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 cross-built inputs, and NATIVE-INPUTS are inputs that run on the build
platform." 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 (define builder
`(begin #~(begin
(use-modules ,@modules) (use-modules #$@modules)
(let ()
(define %build-host-inputs (define %build-host-inputs
',(map (match-lambda (map (lambda (tuple)
((name (? derivation? drv) sub ...) (apply cons tuple))
`(,name . ,(apply derivation->output-path drv sub))) '#+build-inputs))
((name path)
`(,name . ,path)))
native-drvs))
(define %build-target-inputs (define %build-target-inputs
',(map (match-lambda (map (lambda (tuple)
((name (? derivation? drv) sub ...) (apply cons tuple))
`(,name . ,(apply derivation->output-path drv sub))) (append '#$host-inputs '#+target-inputs)))
((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))
(gnu-build #:source ,(match (assoc-ref native-drvs "source") (define %outputs
(((? derivation? source)) (list #$@(map (lambda (name)
(derivation->output-path source)) #~(cons #$name
((source) (ungexp output name)))
source) outputs)))
(source
source)) (gnu-build #:source #+source
#:system ,system #:system #$system
#:build ,build #:build #$build
#:target ,target #:target #$target
#:outputs %outputs #:outputs %outputs
#:inputs %build-target-inputs #:inputs %build-target-inputs
#:native-inputs %build-host-inputs #:native-inputs %build-host-inputs
#:search-paths ',(map search-path-specification->sexp #:search-paths '#$(map search-path-specification->sexp
search-paths) search-paths)
#:native-search-paths ',(map #:native-search-paths '#$(map
search-path-specification->sexp search-path-specification->sexp
native-search-paths) native-search-paths)
#:phases ,phases #:phases #$phases
#:locale ,locale #:locale #$locale
#:bootstrap-scripts ,bootstrap-scripts #:bootstrap-scripts #$bootstrap-scripts
#:configure-flags ,configure-flags #:configure-flags #$configure-flags
#:make-flags ,make-flags #:make-flags #$make-flags
#:out-of-source? ,out-of-source? #:out-of-source? #$out-of-source?
#:tests? ,tests? #:tests? #$tests?
#:test-target ,test-target #:test-target #$test-target
#:parallel-build? ,parallel-build? #:parallel-build? #$parallel-build?
#:parallel-tests? ,parallel-tests? #:parallel-tests? #$parallel-tests?
#:patch-shebangs? ,patch-shebangs? #:patch-shebangs? #$patch-shebangs?
#:strip-binaries? ,strip-binaries? #:license-file-regexp #$license-file-regexp
#:validate-runpath? ,validate-runpath? #:strip-binaries? #$strip-binaries?
#:make-dynamic-linker-cache? ,make-dynamic-linker-cache? #:validate-runpath? #$validate-runpath?
#:license-file-regexp ,license-file-regexp #:make-dynamic-linker-cache? #$make-dynamic-linker-cache?
#:strip-flags ,strip-flags #:license-file-regexp #$license-file-regexp
#:strip-directories ,strip-directories)))) #:strip-flags #$strip-flags
#:strip-directories #$strip-directories)))
(define guile-for-build (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
(match guile system #:graft? #f)))
((? package?) (gexp->derivation name builder
(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 #:system system
#:inputs (append native-drvs target-drvs) #:target target
#:outputs outputs
#:modules imported-modules #:modules imported-modules
#:substitutable? substitutable? #:substitutable? substitutable?
#:allowed-references allowed-references
#:allowed-references #:disallowed-references disallowed-references
(and allowed-references #:guile-for-build guile)))
(map canonicalize-reference
allowed-references))
#:disallowed-references
(and disallowed-references
(map canonicalize-reference
disallowed-references))
#:guile-for-build guile-for-build))
(define gnu-build-system (define gnu-build-system
(build-system (build-system

66
guix/build-system/go.scm
View file

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

136
guix/build-system/guile.scm
View file

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

69
guix/build-system/haskell.scm
View file

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

53
guix/build-system/julia.scm
View file

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

142
guix/build-system/linux-module.scm
View file

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

70
guix/build-system/maven.scm
View file

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

109
guix/build-system/meson.scm
View file

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

52
guix/build-system/minify.scm
View file

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

56
guix/build-system/node.scm
View file

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

83
guix/build-system/ocaml.scm
View file

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

68
guix/build-system/perl.scm
View file

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

63
guix/build-system/python.scm
View file

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

179
guix/build-system/qt.scm
View file

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

60
guix/build-system/r.scm
View file

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

54
guix/build-system/rakudo.scm
View file

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

58
guix/build-system/renpy.scm
View file

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

60
guix/build-system/ruby.scm
View file

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

67
guix/build-system/scons.scm
View file

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

65
guix/build-system/texlive.scm
View file

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

81
guix/build-system/trivial.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,24 +19,16 @@
(define-module (guix build-system trivial) (define-module (guix build-system trivial)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix derivations) #:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix build-system) #:use-module (guix build-system)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (trivial-build-system)) #: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 (define* (lower name
#:key source inputs native-inputs outputs system target #:key source inputs native-inputs outputs system target
guile builder modules allowed-references) guile builder (modules '()) allowed-references)
"Return a bag for NAME." "Return a bag for NAME."
(bag (bag
(name name) (name name)
@ -54,65 +46,42 @@
#:modules ,modules #:modules ,modules
#:allowed-references ,allowed-references)))) #:allowed-references ,allowed-references))))
(define* (trivial-build store name inputs (define* (trivial-build name inputs
#:key #:key
outputs guile system builder (modules '()) outputs guile
system builder (modules '())
search-paths allowed-references) search-paths allowed-references)
"Run build expression BUILDER, an expression, for SYSTEM. SOURCE is "Run build expression BUILDER, an expression, for SYSTEM. SOURCE is
ignored." ignored."
(define canonicalize-reference (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
(match-lambda system #:graft? #f)))
((? package? p) (gexp->derivation name (with-build-variables inputs outputs builder)
(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)))
(build-expression->derivation store name builder
#:inputs inputs
#:system system #:system system
#:outputs outputs #:target #f
#:modules modules #:modules modules
#:allowed-references #:allowed-references allowed-references
(and allowed-references #:guile-for-build guile)))
(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 #:key
target native-drvs target-drvs target
source build-inputs target-inputs host-inputs
outputs guile system builder (modules '()) outputs guile system builder (modules '())
search-paths native-search-paths search-paths native-search-paths
allowed-references) allowed-references)
"Run build expression BUILDER, an expression, for SYSTEM. SOURCE is "Run build expression BUILDER, an expression, for SYSTEM. SOURCE is
ignored." ignored."
(define canonicalize-reference (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
(match-lambda system #:graft? #f)))
((? package? p) (gexp->derivation name (with-build-variables
(derivation->output-path (package-cross-derivation store p system))) (append build-inputs target-inputs)
(((? package? p) output) outputs
(derivation->output-path (package-cross-derivation store p system) builder)
output))
((? string? output)
output)))
(build-expression->derivation store name builder
#:inputs (append native-drvs target-drvs)
#:system system #:system system
#:outputs outputs #:target target
#:modules modules #:modules modules
#:allowed-references #:allowed-references allowed-references
(and allowed-references #:guile-for-build guile)))
(map canonicalize-reference
allowed-references))
#:guile-for-build
(guile-for-build store guile system)))
(define trivial-build-system (define trivial-build-system
(build-system (build-system

58
guix/build-system/waf.scm
View file

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

1
guix/gexp.scm
View file

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

77
guix/packages.scm
View file

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

2
tests/builders.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2021 Lars-Dominik Braun <lars@6xq.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.

4
tests/lint.scm
View file

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org> ;;; 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 © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2017 Alex Kost <alezost@gmail.com> ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
@ -432,7 +432,7 @@
(single-lint-warning-message (check-patch-headers pkg))))) (single-lint-warning-message (check-patch-headers pkg)))))
(test-equal "derivation: invalid arguments" (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" (match (let ((pkg (dummy-package "x"
(arguments (arguments
'(#:imported-modules (invalid-module)))))) '(#:imported-modules (invalid-module))))))

10
tests/packages.scm
View file

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