me
/
guix
Archived
1
0
Fork 0
Code

build-system: Rewrite using gexps. 

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

squash! build-system: Rewrite using gexps.

squash! build-system: Rewrite using gexps.
master
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
Show Stats 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))

113
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,59 +378,58 @@ 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 '(begin
;; unpacked, creates a wrapper for itself to set its load path. (use-modules (ice-9 match))
;; This replaces the previous non-portable method based on (match (command-line)
;; reading the /proc/self/exe symlink. ((_ out bash)
(make-guile-wrapper (let ((bin-dir (string-append out "/bin"))
'(begin (guile (string-append out "/bin/guile"))
(use-modules (ice-9 match)) (guile-real (string-append out "/bin/.guile-real"))
(match (command-line) ;; We must avoid using a bare dollar sign in this code,
((_ out bash) ;; because it would be interpreted by the shell.
(let ((bin-dir (string-append out "/bin")) (dollar (string (integer->char 36))))
(guile (string-append out "/bin/guile")) (chmod bin-dir #o755)
(guile-real (string-append out "/bin/.guile-real")) (rename-file guile guile-real)
;; We must avoid using a bare dollar sign in this code, (call-with-output-file guile
;; because it would be interpreted by the shell. (lambda (p)
(dollar (string (integer->char 36)))) (format p "\
(chmod bin-dir #o755)
(rename-file guile guile-real)
(call-with-output-file guile
(lambda (p)
(format p "\
#!~a #!~a
export GUILE_SYSTEM_PATH=~a/share/guile/2.0 export GUILE_SYSTEM_PATH=~a/share/guile/2.0
export GUILE_SYSTEM_COMPILED_PATH=~a/lib/guile/2.0/ccache export GUILE_SYSTEM_COMPILED_PATH=~a/lib/guile/2.0/ccache
exec -a \"~a0\" ~a \"~a@\"\n" 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))))))
(builder
(add-text-to-store store (mlet* %store-monad ((tar (->store "tar"))
"build-bootstrap-guile.sh" (xz (->store "xz"))
(format #f " (mkdir (->store "mkdir"))
(bash (->store "bash"))
(guile (download-bootstrap-guile system))
(wrapper -> (make-guile-wrapper bash guile))
(builder
(text-file "build-bootstrap-guile.sh"
(format #f "
echo \"unpacking bootstrap Guile to '$out'...\" echo \"unpacking bootstrap Guile to '$out'...\"
~a $out ~a $out
cd $out cd $out
@ -441,19 +442,19 @@ $out/bin/guile -c ~s $out ~a
# Sanity check. # Sanity check.
$out/bin/guile --version~%" $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
(list bash mkdir tar xz guile)) (list bash mkdir tar xz guile))
#:sources (list builder) #:sources (list builder)
#:env-vars `(("GUILE_TARBALL" #:env-vars `(("GUILE_TARBALL"
. ,(derivation->output-path guile)))))) . ,(derivation->output-path guile))))))
(define* (make-raw-bag name (define* (make-raw-bag name
#:key source inputs native-inputs outputs #:key source inputs native-inputs outputs

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?)

97
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,62 +36,49 @@
(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
(tests? #t) source
(test-target #f) (tests? #t)
(phases '(@ (guix build android-ndk-build-system) (test-target #f)
%standard-phases)) (phases '(@ (guix build android-ndk-build-system)
(outputs '("out")) %standard-phases))
(make-flags ''()) (outputs '("out"))
(search-paths '()) (make-flags #~'())
(system (%current-system)) (search-paths '())
(guile #f) (system (%current-system))
(imported-modules %android-ndk-build-system-modules) (guile #f)
(modules '((guix build android-ndk-build-system) (imported-modules %android-ndk-build-system-modules)
(guix build utils)))) (modules '((guix build android-ndk-build-system)
(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))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:test-target ,test-target
#:tests? ,tests?
#:phases ,phases
#:make-flags (cons* "-f"
,(string-append
(derivation->output-path
(car (assoc-ref inputs "android-build")))
"/share/android/build/core/main.mk")
,make-flags)
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(define guile-for-build (android-ndk-build #:name #$name
(match guile #:source #+source
((? package?) #:system #$system
(package-derivation store guile system #:graft? #f)) #:test-target #$test-target
(#f ; the default #:tests? #$tests?
(let* ((distro (resolve-interface '(gnu packages commencement))) #:phases #$phases
(guile (module-ref distro 'guile-final))) #:make-flags
(package-derivation store guile system #:graft? #f))))) (cons* "-f"
#$(file-append (car (assoc-ref inputs
"android-build"))
"/share/android/build/core/main.mk")
#$make-flags)
#:outputs #$(outputs->gexp outputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs #$(input-tuples->gexp inputs)))))
(build-expression->derivation store name builder (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
#:inputs inputs system #:graft? #f)))
#:system system (gexp->derivation name builder
#:modules imported-modules #:system system
#:outputs outputs #:guile-for-build guile)))
#: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

78
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 search-paths)
#:test-dir ,test-dir #:inputs #$(input-tuples->gexp inputs)))))
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#: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)) #:system system
(#f ; the default #:guile-for-build guile)))
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(define ant-build-system (define ant-build-system
(build-system (build-system

140
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 search-paths)
#:outputs %outputs #:inputs #$(input-tuples->gexp inputs)))))
#:search-paths ',(map search-path-specification->sexp
search-paths)
#: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)) #:system system
(#f #:guile-for-build guile)))
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(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,19 +266,19 @@ 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 ''())
(asd-systems ''()) (asd-systems ''())
(test-asd-file #f) (test-asd-file #f)
(phases '(@ (guix build asdf-build-system) (phases '(@ (guix build asdf-build-system)
%standard-phases)) %standard-phases))
(search-paths '()) (search-paths '())
(system (%current-system)) (system (%current-system))
(guile #f) (guile #f)
(imported-modules %asdf-build-system-modules) (imported-modules %asdf-build-system-modules)
(modules %asdf-build-modules)) (modules %asdf-build-modules))
;; FIXME: The definition of 'systems' is pretty hacky. ;; FIXME: The definition of 'systems' is pretty hacky.
;; Is there a more elegant way to do it? ;; Is there a more elegant way to do it?
@ -300,48 +289,35 @@ set up using CL source package conventions."
(string-drop (string-drop
;; NAME is the value returned from `package-full-name'. ;; NAME is the value returned from `package-full-name'.
(hyphen-separated-name->name+version name) (hyphen-separated-name->name+version name)
(1+ (string-length lisp-type))))) ; drop the "<lisp>-" prefix. (1+ (string-length lisp-type))))) ; drop the "<lisp>-" prefix.
asd-systems)) asd-systems))
(define builder (define builder
`(begin (with-imported-modules imported-modules
(use-modules ,@modules) #~(begin
(parameterize ((%lisp (string-append (use-modules #$@modules)
(assoc-ref %build-inputs ,lisp-type) (parameterize ((%lisp (string-append
"/bin/" ,lisp-type)) (assoc-ref %build-inputs #$lisp-type)
(%lisp-type ,lisp-type)) "/bin/" #$lisp-type))
(asdf-build #:name ,name (%lisp-type #$lisp-type))
#:source ,(match (assoc-ref inputs "source") (asdf-build #:name #$name
(((? derivation? source)) #:source #+source
(derivation->output-path source)) #:asd-files #$asd-files
((source) source) #:asd-systems #$systems
(source source)) #:test-asd-file #$test-asd-file
#:asd-files ,asd-files #:system #$system
#:asd-systems ,systems #:tests? #$tests?
#:test-asd-file ,test-asd-file #:phases #$phases
#:system ,system #:outputs #$(outputs->gexp outputs)
#:tests? ,tests? #:search-paths '#$(map search-path-specification->sexp
#:phases ,phases search-paths)
#:outputs %outputs #:inputs #$(input-tuples->gexp inputs))))))
#:search-paths ',(map search-path-specification->sexp
search-paths)
#: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)) #:system system
(#f #:guile-for-build guile))))
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build)))
(define asdf-build-system/sbcl (define asdf-build-system/sbcl
(build-system (build-system

78
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 #:target #f
#:modules imported-modules #:guile-for-build guile))
#:outputs outputs
#: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

96
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,60 +72,45 @@
(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
(phases '(@ (guix build chicken-build-system) source
%standard-phases)) (phases '(@ (guix build chicken-build-system)
(outputs '("out")) %standard-phases))
(search-paths '()) (outputs '("out"))
(egg-name "") (search-paths '())
(unpack-path "") (egg-name "")
(build-flags ''()) (unpack-path "")
(tests? #t) (build-flags ''())
(system (%current-system)) (tests? #t)
(guile #f) (system (%current-system))
(imported-modules %chicken-build-system-modules) (guile #f)
(modules '((guix build chicken-build-system) (imported-modules %chicken-build-system-modules)
(guix build union) (modules '((guix build chicken-build-system)
(guix build utils)))) (guix build union)
(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)) search-paths)
#:system ,system #:egg-name #$egg-name
#:phases ,phases #:unpack-path #$unpack-path
#:outputs %outputs #:build-flags #$build-flags
#:search-paths ',(map search-path-specification->sexp #:tests? #$tests?
search-paths) #:inputs #$(input-tuples->gexp inputs)))))
#:egg-name ,egg-name
#:unpack-path ,unpack-path
#:build-flags ,build-flags
#:tests? ,tests?
#: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)) #:system system
(#f ; the default #:guile-for-build guile)))
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system
#:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(define chicken-build-system (define chicken-build-system
(build-system (build-system

93
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)
@ -133,7 +118,7 @@
(aot-include `',%aot-include) (aot-include `',%aot-include)
(aot-exclude `',%aot-exclude) (aot-exclude `',%aot-exclude)
doc-dirs ; no sensible default doc-dirs ; no sensible default
(doc-regex %doc-regex) (doc-regex %doc-regex)
(tests? %tests?) (tests? %tests?)
@ -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
search-paths)
#:system ,system
#:inputs %build-inputs)))
(guile-for-build (package-derivation store #:phases #$phases
(maybe-guile->guile guile) #:outputs #$(outputs->gexp outputs)
system #:search-paths '#$(map search-path-spec->sexp
#:graft? #f))) search-paths)
#:system #$system
#:inputs #$(input-tuples->gexp inputs)))))
(build-expression->derivation store name builder (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
#:inputs inputs system #:graft? #f)))
#:system system (gexp->derivation name builder
#:modules imported-modules #:system system
#:outputs outputs #:guile-for-build guile)))
#:guile-for-build guile-for-build)))
(define clojure-build-system (define clojure-build-system
(build-system (build-system

211
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))
((source)
source)
(source
source))
#:system ,system
#:outputs %outputs
#:inputs %build-inputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:phases ,phases
#:configure-flags ,configure-flags
#:make-flags ,make-flags
#:out-of-source? ,out-of-source?
#:build-type ,build-type
#:tests? ,tests?
#:test-target ,test-target
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories)))
(define guile-for-build #$(with-build-variables inputs outputs
(match guile #~(cmake-build #:source #+source
((? package?) #:system #$system
(package-derivation store guile system #:graft? #f)) #:outputs %outputs
(#f ; the default #:inputs %build-inputs
(let* ((distro (resolve-interface '(gnu packages commencement))) #:search-paths '#$(map search-path-specification->sexp
(guile (module-ref distro 'guile-final))) search-paths)
(package-derivation store guile system #:graft? #f))))) #:phases #$phases
#:configure-flags #$configure-flags
#:make-flags #$make-flags
#:out-of-source? #$out-of-source?
#:build-type #$build-type
#:tests? #$tests?
#:test-target #$test-target
#:parallel-build? #$parallel-build?
#:parallel-tests? #$parallel-tests?
#:validate-runpath? #$validate-runpath?
#:patch-shebangs? #$patch-shebangs?
#:strip-binaries? #$strip-binaries?
#:strip-flags #$strip-flags
#:strip-directories #$strip-directories)))))
(build-expression->derivation store name builder (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
#:system system system #:graft? #f)))
#:inputs inputs (gexp->derivation name build
#:modules imported-modules #:system system
#:outputs outputs #:target #f
#: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
',(map (match-lambda
((name (? derivation? drv) sub ...)
`(,name . ,(apply derivation->output-path drv sub)))
((name path)
`(,name . ,path)))
native-drvs))
(define %build-target-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 (? 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 %build-target-inputs
(((? derivation? source)) (map (lambda (tuple)
(derivation->output-path source)) (apply cons tuple))
((source) '#$host-inputs))
source)
(source
source))
#:system ,system
#:build ,build
#:target ,target
#:outputs %outputs
#:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:native-search-paths ',(map
search-path-specification->sexp
native-search-paths)
#:phases ,phases
#:configure-flags ,configure-flags
#:make-flags ,make-flags
#:out-of-source? ,out-of-source?
#:build-type ,build-type
#:tests? ,tests?
#:test-target ,test-target
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories))))
(define guile-for-build (define %outputs
(match guile (list #$@(map (lambda (name)
((? package?) #~(cons #$name
(package-derivation store guile system #:graft? #f)) (ungexp output name)))
(#f ; the default outputs)))
(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 (cmake-build #:source #+source
#:system system #:system #$system
#:inputs (append native-drvs target-drvs) #:build #$build
#:outputs outputs #:target #$target
#:modules imported-modules #:outputs %outputs
#:substitutable? substitutable? #:inputs %build-target-inputs
#:guile-for-build guile-for-build)) #:native-inputs %build-host-inputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:native-search-paths '#$(map
search-path-specification->sexp
native-search-paths)
#:phases #$phases
#:configure-flags #$configure-flags
#:make-flags #$make-flags
#:out-of-source? #$out-of-source?
#:build-type #$build-type
#:tests? #$tests?
#:test-target #$test-target
#:parallel-build? #$parallel-build?
#:parallel-tests? #$parallel-tests?
#:validate-runpath? #$validate-runpath?
#:patch-shebangs? #$patch-shebangs?
#:strip-binaries? #$strip-binaries?
#:strip-flags #$strip-flags
#:strip-directories #$strip-directories))))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:target target
#:substitutable? substitutable?
#:guile-for-build guile)))
(define cmake-build-system (define cmake-build-system
(build-system (build-system

72
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))
((source)
source)
(source
source))
#:system ,system
#:outputs %outputs
#:inputs %build-inputs
#:install-plan ,install-plan
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:phases ,phases
#:out-of-source? ,out-of-source?
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories)))
(define guile-for-build #$(with-build-variables inputs outputs
(match guile #~(copy-build #:source #+source
((? package?) #:system #$system
(package-derivation store guile system #:graft? #f)) #:outputs %outputs
(#f ; the default #:inputs %build-inputs
(let* ((distro (resolve-interface '(gnu packages commencement))) #:install-plan #$install-plan
(guile (module-ref distro 'guile-final))) #:search-paths '#$(map search-path-specification->sexp
(package-derivation store guile system #:graft? #f))))) search-paths)
#:phases #$phases
#:out-of-source? #$out-of-source?
#:validate-runpath? #$validate-runpath?
#:patch-shebangs? #$patch-shebangs?
#:strip-binaries? #$strip-binaries?
#:strip-flags #$strip-flags
#:strip-directories #$strip-directories)))))
(build-expression->derivation store name builder (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
#:system system system #:graft? #f)))
#:inputs inputs (gexp->derivation name builder
#:modules imported-modules #:system system
#:outputs outputs #:target #f
#:guile-for-build guile-for-build)) #:guile-for-build guile)))
(define copy-build-system (define copy-build-system
(build-system (build-system

89
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,57 +57,43 @@
(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
(tests? #t) source
(test-target #f) (tests? #t)
(dub-build-flags ''()) (test-target #f)
(phases '(@ (guix build dub-build-system) (dub-build-flags ''())
%standard-phases)) (phases '(@ (guix build dub-build-system)
(outputs '("out")) %standard-phases))
(search-paths '()) (outputs '("out"))
(system (%current-system)) (search-paths '())
(guile #f) (system (%current-system))
(imported-modules %dub-build-system-modules) (guile #f)
(modules '((guix build dub-build-system) (imported-modules %dub-build-system-modules)
(guix build utils)))) (modules '((guix build dub-build-system)
(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 search-paths)
#:tests? ,tests? #:inputs #$(input-tuples->gexp inputs)))))
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#: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)) #:system system
(#f ; the default #:guile-for-build guile)))
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(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

85
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 #:system system
((? package?) #:target #f
(package-derivation store guile system #:graft? #f)) #:guile-for-build guile))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(define dune-build-system (define dune-build-system
(build-system (build-system

62
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 search-paths)
#:outputs %outputs #:inputs #$(input-tuples->gexp inputs)))))
#:include ,include
#:exclude ,exclude
#:search-paths ',(map search-path-specification->sexp
search-paths)
#: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)) #:system system
(#f ; the default #:guile-for-build guile)))
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(define emacs-build-system (define emacs-build-system
(build-system (build-system

59
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))
(derivation->output-path source))
((source)
source)
(source
source))
#:configure-flags ,configure-flags
#:system ,system
#:test-target ,test-target
#:tests? ,tests?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(define guile-for-build #$(with-build-variables inputs outputs
(match guile #~(font-build #:name #$name
((? package?) #:source #+source
(package-derivation store guile system #:graft? #f)) #:configure-flags #$configure-flags
(#f ; the default #:system #$system
(let* ((distro (resolve-interface '(gnu packages commencement))) #:test-target #$test-target
(guile (module-ref distro 'guile-final))) #:tests? #$tests?
(package-derivation store guile system #:graft? #f))))) #:phases #$phases
#:outputs %outputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))))
(build-expression->derivation store name builder (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
#:inputs inputs system #:graft? #f)))
#:system system (gexp->derivation name builder
#:modules imported-modules #:system system
#:outputs outputs #:target #f
#:guile-for-build guile-for-build)) #:guile-for-build guile)))
(define font-build-system (define font-build-system
(build-system (build-system

105
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") #:outputs %outputs
(((? derivation? source)) #:inputs %build-inputs
(derivation->output-path source)) #:search-paths '#$(map search-path-specification->sexp
((source) search-paths)
source) #:phases #$phases
(source #:glib-or-gtk-wrap-excluded-outputs
source)) #$glib-or-gtk-wrap-excluded-outputs
#:system ,system #:configure-flags #$configure-flags
#:outputs %outputs #:make-flags #$make-flags
#:inputs %build-inputs #:out-of-source? #$out-of-source?
#:search-paths ',(map search-path-specification->sexp #:tests? #$tests?
search-paths) #:test-target #$test-target
#:phases ,phases #:parallel-build? #$parallel-build?
#:glib-or-gtk-wrap-excluded-outputs #:parallel-tests? #$parallel-tests?
,glib-or-gtk-wrap-excluded-outputs #:validate-runpath? #$validate-runpath?
#:configure-flags ,configure-flags #:patch-shebangs? #$patch-shebangs?
#:make-flags ,make-flags #:strip-binaries? #$strip-binaries?
#:out-of-source? ,out-of-source? #:strip-flags #$strip-flags
#:tests? ,tests? #:strip-directories #$strip-directories)))))
#:test-target ,test-target
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories)))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
#:system system system #:graft? #f)))
#:inputs inputs (gexp->derivation name build
#:modules imported-modules #:system system
#:outputs outputs #:target #f
#:allowed-references #:allowed-references allowed-references
(and allowed-references #:disallowed-references disallowed-references
(map canonicalize-reference #:guile-for-build guile)))
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

272
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))
((source)
source)
(source
source))
#:system ,system
#:build ,build
#:outputs %outputs
#:inputs %build-inputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:phases ,phases
#:locale ,locale
#:bootstrap-scripts ,bootstrap-scripts
#:configure-flags ,configure-flags
#:make-flags ,make-flags
#:out-of-source? ,out-of-source?
#:tests? ,tests?
#:test-target ,test-target
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:validate-runpath? ,validate-runpath?
#:make-dynamic-linker-cache? ,make-dynamic-linker-cache?
#:license-file-regexp ,license-file-regexp
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories)))
(define guile-for-build #$(with-build-variables inputs outputs
(match guile #~(gnu-build #:source #+source
((? package?) #:system #$system
(package-derivation store guile system #:graft? #f)) #:build #$build
(#f ; the default #:outputs %outputs
(let* ((distro (resolve-interface '(gnu packages commencement))) #:inputs %build-inputs
(guile (module-ref distro 'guile-final))) #:search-paths '#$(map search-path-specification->sexp
(package-derivation store guile system search-paths)
#:graft? #f))))) #:phases #$phases
#:locale #$locale
#:bootstrap-scripts #$bootstrap-scripts
#:configure-flags #$configure-flags
#:make-flags #$make-flags
#:out-of-source? #$out-of-source?
#:tests? #$tests?
#:test-target #$test-target
#:parallel-build? #$parallel-build?
#:parallel-tests? #$parallel-tests?
#:patch-shebangs? #$patch-shebangs?
#:license-file-regexp #$license-file-regexp
#:strip-binaries? #$strip-binaries?
#:validate-runpath? #$validate-runpath?
#:make-dynamic-linker-cache? #$make-dynamic-linker-cache?
#:license-file-regexp #$license-file-regexp
#:strip-flags #$strip-flags
#:strip-directories #$strip-directories)))))
(build-expression->derivation store name builder (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
#:system system system #:graft? #f)))
#:inputs input-drvs (gexp->derivation name builder
#:outputs outputs #:system system
#:modules imported-modules #:target #f
#: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 (lambda (tuple)
',(map (match-lambda (apply cons tuple))
((name (? derivation? drv) sub ...) '#+build-inputs))
`(,name . ,(apply derivation->output-path drv sub)))
((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)) #:system system
(#f ; the default #:target target
(let* ((distro (resolve-interface '(gnu packages commencement))) #:modules imported-modules
(guile (module-ref distro 'guile-final))) #:substitutable? substitutable?
(package-derivation store guile system #:graft? #f))))) #:allowed-references allowed-references
#:disallowed-references disallowed-references
(build-expression->derivation store name builder #:guile-for-build guile)))
#:system system
#:inputs (append native-drvs target-drvs)
#:outputs outputs
#:modules imported-modules
#:substitutable? substitutable?
#:allowed-references
(and allowed-references
(map canonicalize-reference
allowed-references))
#:disallowed-references
(and disallowed-references
(map canonicalize-reference
disallowed-references))
#:guile-for-build guile-for-build))
(define gnu-build-system (define gnu-build-system
(build-system (build-system

70
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)) search-paths)
#:system ,system #:install-source? #$install-source?
#:phases ,phases #:import-path #$import-path
#:outputs %outputs #:unpack-path #$unpack-path
#:search-paths ',(map search-path-specification->sexp #:build-flags #$build-flags
search-paths) #:tests? #$tests?
#:install-source? ,install-source? #:allow-go-reference? #$allow-go-reference?
#:import-path ,import-path #:inputs #$(input-tuples->gexp inputs)))))
#:unpack-path ,unpack-path
#:build-flags ,build-flags
#:tests? ,tests?
#:allow-go-reference? ,allow-go-reference?
#: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)) #:system system
(#f ; the default #:guile-for-build guile)))
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system
#:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(define go-build-system (define go-build-system
(build-system (build-system

154
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)))
#:system system (gexp->derivation name builder
#:modules imported-modules #:system system
#:outputs outputs #:target #f
#:guile-for-build guile-for-build)) #:guile-for-build guile)))
(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 #+(input-tuples->gexp build-inputs))
',(map (match-lambda
((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)
source)
(source
source))
#:system ,system
#:target ,target
#:outputs %outputs
#:source-directory ,source-directory
#:not-compiled-file-regexp ,not-compiled-file-regexp
#:compile-flags ,compile-flags
#:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:native-search-paths ',(map
search-path-specification->sexp
native-search-paths)
#:phases ,phases))))
(define guile-for-build (guile-build #:source #+source
(match guile #:system #$system
((? package?) #:target #$target
(package-derivation store guile system #:graft? #f)) #:outputs %outputs
(#f ; the default #:source-directory #$source-directory
(let* ((distro (resolve-interface '(gnu packages commencement))) #:not-compiled-file-regexp #$not-compiled-file-regexp
(guile (module-ref distro 'guile-final))) #:compile-flags #$compile-flags
(package-derivation store guile system #:graft? #f))))) #:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:native-search-paths '#$(map
search-path-specification->sexp
native-search-paths)
#:phases #$phases))))
(build-expression->derivation store name builder (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
#:system system system #:graft? #f)))
#:inputs (append native-drvs target-drvs) (gexp->derivation name builder
#:outputs outputs #:system system
#:modules imported-modules #:target target
#:substitutable? substitutable? #:guile-for-build guile)))
#:guile-for-build guile-for-build))
(define guile-build-system (define guile-build-system
(build-system (build-system

73
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))
(derivation->output-path source))
((source)
source)
(source
source))
#:cabal-revision ,(match (assoc-ref inputs
"cabal-revision")
(((? derivation? revision))
(derivation->output-path revision))
(revision revision))
#:configure-flags ,configure-flags
#:extra-directories ,extra-directories
#:haddock-flags ,haddock-flags
#:system ,system
#:test-target ,test-target
#:tests? ,tests?
#:parallel-build? ,parallel-build?
#:haddock? ,haddock?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(define guile-for-build (haskell-build #:name #$name
(match guile #:source #+source
((? package?) #:cabal-revision #$(assoc-ref inputs
(package-derivation store guile system #:graft? #f)) "cabal-revision")
(#f ; the default #:configure-flags #$configure-flags
(let* ((distro (resolve-interface '(gnu packages commencement))) #:extra-directories #$extra-directories
(guile (module-ref distro 'guile-final))) #:haddock-flags #$haddock-flags
(package-derivation store guile system #:graft? #f))))) #:system #$system
#:test-target #$test-target
#:tests? #$tests?
#:parallel-build? #$parallel-build?
#:haddock? #$haddock?
#:phases #$phases
#:outputs #$(outputs->gexp outputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs #$(input-tuples->gexp inputs)))))
(build-expression->derivation store name builder (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
#:inputs inputs system #:graft? #f)))
#:system system (gexp->derivation name builder
#:modules imported-modules #:system system
#:outputs outputs #:guile-for-build guile)))
#:guile-for-build guile-for-build))
(define haskell-build-system (define haskell-build-system
(build-system (build-system

57
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 search-paths)
#:tests? ,tests? #:inputs #$(input-tuples->gexp inputs)
#:phases ,phases #:julia-package-name #$julia-package-name))))
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs
#: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)) #:system system
(#f ; the default #:guile-for-build guile)))
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(define julia-build-system (define julia-build-system
(build-system (build-system

164
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) search-paths)
source) #:phases #$phases
(source #:system #$system
source)) #:target #$target
#:search-paths ',(map search-path-specification->sexp #:arch #$(system->arch (or target system))
search-paths) #:tests? #$tests?
#:phases ,phases #:outputs #$(outputs->gexp outputs)
#:system ,system #:make-flags #$make-flags
#:target ,target #:inputs #$(input-tuples->gexp inputs)))))
#:arch ,(system->arch (or target system))
#:tests? ,tests?
#:outputs %outputs
#:make-flags ,make-flags
#: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)) #:system system
(#f ; the default #:guile-for-build guile
(let* ((distro (resolve-interface '(gnu packages commencement))) #:substitutable? substitutable?)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build
#:substitutable? substitutable?))
(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
',(map (match-lambda
((name (? derivation? drv) sub ...)
`(,name . ,(apply derivation->output-path drv sub)))
((name path)
`(,name . ,path)))
native-drvs))
(define %build-target-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 (? 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 (define %build-target-inputs
#:source ,(match (assoc-ref native-drvs "source") (append #$(input-tuples->gexp host-inputs)
(((? derivation? source)) #+(input-tuples->gexp target-inputs)))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:target ,target
#:arch ,(system->arch (or target system))
#:outputs %outputs
#:make-flags ,make-flags
#:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths
',(map search-path-specification->sexp
search-paths)
#:native-search-paths
',(map
search-path-specification->sexp
native-search-paths)
#:phases ,phases
#:tests? ,tests?))))
(define guile-for-build (linux-module-build #:name #$name
(match guile #:source #+source
((? package?) #:system #$system
(package-derivation store guile system #:graft? #f)) #:target #$target
(#f ; the default #:arch #$(system->arch (or target system))
(let* ((distro (resolve-interface '(gnu packages commencement))) #:outputs #$(outputs->gexp outputs)
(guile (module-ref distro 'guile-final))) #:make-flags #$make-flags
(package-derivation store guile system #:graft? #f))))) #:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths
'#$(map search-path-specification->sexp
search-paths)
#:native-search-paths
'#$(map
search-path-specification->sexp
native-search-paths)
#:phases #$phases
#:tests? #$tests?))))
(build-expression->derivation store name builder (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
#:system system system #:graft? #f)))
#:inputs (append native-drvs target-drvs) (gexp->derivation name builder
#:outputs outputs #:system system
#:modules imported-modules #:guile-for-build guile
#:guile-for-build guile-for-build #:substitutable? substitutable?)))
#:substitutable? substitutable?))
(define linux-module-build-system (define linux-module-build-system
(build-system (build-system

112
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,70 +142,56 @@
(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
(outputs '("out")) source (guile #f)
(search-paths '()) (outputs '("out"))
(out-of-source? #t) (search-paths '())
(validate-runpath? #t) (out-of-source? #t)
(patch-shebangs? #t) (validate-runpath? #t)
(strip-binaries? #t) (patch-shebangs? #t)
(exclude %default-exclude) (strip-binaries? #t)
(local-packages '()) (exclude %default-exclude)
(tests? #t) (local-packages '())
(strip-flags ''("--strip-debug")) (tests? #t)
(strip-directories ''("lib" "lib64" "libexec" (strip-flags ''("--strip-debug"))
"bin" "sbin")) (strip-directories ''("lib" "lib64" "libexec"
(phases '(@ (guix build maven-build-system) "bin" "sbin"))
%standard-phases)) (phases '(@ (guix build maven-build-system)
(system (%current-system)) %standard-phases))
(imported-modules %maven-build-system-modules) (system (%current-system))
(modules '((guix build maven-build-system) (imported-modules %maven-build-system-modules)
(guix build maven pom) (modules '((guix build maven-build-system)
(guix build utils)))) (guix build maven pom)
(guix build utils))))
"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)) search-paths)
#:system ,system #:phases #$phases
#:outputs %outputs #:exclude '#$exclude
#:inputs %build-inputs #:local-packages '#$local-packages
#:search-paths ',(map search-path-specification->sexp #:tests? #$tests?
search-paths) #:out-of-source? #$out-of-source?
#:phases ,phases #:validate-runpath? #$validate-runpath?
#:exclude (quote ,exclude) #:patch-shebangs? #$patch-shebangs?
#:local-packages (quote ,local-packages) #:strip-binaries? #$strip-binaries?
#:tests? ,tests? #:strip-flags #$strip-flags
#:out-of-source? ,out-of-source? #:strip-directories #$strip-directories))))
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#: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)) #:system system
(#f ; the default #:guile-for-build guile)))
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(define maven-build-system (define maven-build-system
(build-system (build-system

119
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)
(delete 'glib-or-gtk-compile-schemas)
(delete 'glib-or-gtk-wrap)))))
(use-modules ,@modules)
(meson-build #:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:outputs %outputs
#:inputs %build-inputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:phases build-phases
#:configure-flags ,configure-flags
#:build-type ,build-type
#:tests? ,tests?
#:test-target ,test-target
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories
#:elf-directories ,elf-directories)))
(define guile-for-build (define build-phases
(match guile #$(if glib-or-gtk?
((? package?) phases
(package-derivation store guile system #:graft? #f)) #~(modify-phases #$phases
(#f ; the default (delete 'glib-or-gtk-compile-schemas)
(let* ((distro (resolve-interface '(gnu packages commencement))) (delete 'glib-or-gtk-wrap))))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder #$(with-build-variables inputs outputs
#:system system #~(meson-build #:source #+source
#:inputs inputs #:system #$system
#:modules imported-modules #:outputs %outputs
#:outputs outputs #:inputs %build-inputs
#:guile-for-build guile-for-build #:search-paths '#$(map search-path-specification->sexp
#:allowed-references search-paths)
(and allowed-references #:phases build-phases
(map canonicalize-reference #:configure-flags #$configure-flags
allowed-references)) #:build-type #$build-type
#:disallowed-references #:tests? #$tests?
(and disallowed-references #:test-target #$test-target
(map canonicalize-reference #:parallel-build? #$parallel-build?
disallowed-references)))) #:parallel-tests? #$parallel-tests?
#:validate-runpath? #$validate-runpath?
#:patch-shebangs? #$patch-shebangs?
#:strip-binaries? #$strip-binaries?
#:strip-flags #$strip-flags
#:strip-directories #$strip-directories
#:elf-directories #$elf-directories)))))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:target #f
#:substitutable? substitutable?
#:allowed-references allowed-references
#:disallowed-references disallowed-references
#:guile-for-build guile)))
(define meson-build-system (define meson-build-system
(build-system (build-system

56
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)) search-paths)
#:javascript-files ,javascript-files #:inputs #$(input-tuples->gexp inputs)))))
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#: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)) #:system system
(#f ; the default #:guile-for-build guile)))
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(define minify-build-system (define minify-build-system
(build-system (build-system

60
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 search-paths)
#:tests? ,tests? #:inputs #$(input-tuples->gexp inputs)))))
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#: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)) #:system system
(#f #:guile-for-build guile)))
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(define node-build-system (define node-build-system
(build-system (build-system

87
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 #:system system
((? package?) #:target #f
(package-derivation store guile system #:graft? #f)) #:guile-for-build guile))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(define ocaml-build-system (define ocaml-build-system
(build-system (build-system

74
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))
(derivation->output-path source))
((source)
source)
(source
source))
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:make-maker? ,make-maker?
#:make-maker-flags ,make-maker-flags
#:module-build-flags ,module-build-flags
#:phases ,phases
#:system ,system
#:test-target "test"
#:tests? ,tests?
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:outputs %outputs
#:inputs %build-inputs)))
(define guile-for-build #$(with-build-variables inputs outputs
(match guile #~(perl-build #:name #$name
((? package?) #:source #+source
(package-derivation store guile system #:graft? #f)) #:search-paths '#$(map search-path-specification->sexp
(#f ; the default search-paths)
(let* ((distro (resolve-interface '(gnu packages commencement))) #:make-maker? #$make-maker?
(guile (module-ref distro 'guile-final))) #:make-maker-flags #$make-maker-flags
(package-derivation store guile system #:graft? #f))))) #:module-build-flags #$module-build-flags
#:phases #$phases
#:system #$system
#:test-target "test"
#:tests? #$tests?
#:parallel-build? #$parallel-build?
#:parallel-tests? #$parallel-tests?
#:outputs %outputs
#:inputs %build-inputs)))))
(build-expression->derivation store name builder (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
#:system system system #:graft? #f)))
#:inputs inputs (gexp->derivation name build
#:modules imported-modules #:system system
#:outputs outputs #:target #f
#:guile-for-build guile-for-build)) #:guile-for-build guile)))
(define perl-build-system (define perl-build-system
(build-system (build-system

69
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))
(derivation->output-path source))
((source)
source)
(source
source))
#:configure-flags ,configure-flags
#:system ,system
#:test-target ,test-target
#:tests? ,tests?
#:use-setuptools? ,use-setuptools?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(define guile-for-build #$(with-build-variables inputs outputs
(match guile #~(python-build #:name #$name
((? package?) #:source #+source
(package-derivation store guile system #:graft? #f)) #:configure-flags #$configure-flags
(#f ; the default #:use-setuptools? #$use-setuptools?
(let* ((distro (resolve-interface '(gnu packages commencement))) #:system #$system
(guile (module-ref distro 'guile-final))) #:test-target #$test-target
(package-derivation store guile system #:graft? #f))))) #:tests? #$tests?
#:phases #$phases
#:outputs %outputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))))
(build-expression->derivation store name builder
#:inputs inputs (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
#:system system system #:graft? #f)))
#:modules imported-modules (gexp->derivation name build
#:outputs outputs #:system system
#:guile-for-build guile-for-build)) #:target #f
#:guile-for-build guile)))
(define python-build-system (define python-build-system
(build-system (build-system

201
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)) search-paths)
#:system ,system #:phases #$phases
#:outputs %outputs #:qt-wrap-excluded-outputs #$qt-wrap-excluded-outputs
#:inputs %build-inputs #:configure-flags #$configure-flags
#:search-paths ',(map search-path-specification->sexp #:make-flags #$make-flags
search-paths) #:out-of-source? #$out-of-source?
#:phases ,phases #:build-type #$build-type
#:qt-wrap-excluded-outputs ,qt-wrap-excluded-outputs #:tests? #$tests?
#:configure-flags ,configure-flags #:test-target #$test-target
#:make-flags ,make-flags #:parallel-build? #$parallel-build?
#:out-of-source? ,out-of-source? #:parallel-tests? #$parallel-tests?
#:build-type ,build-type #:validate-runpath? #$validate-runpath?
#:tests? ,tests? #:patch-shebangs? #$patch-shebangs?
#:test-target ,test-target #:strip-binaries? #$strip-binaries?
#:parallel-build? ,parallel-build? #:strip-flags #$strip-flags
#:parallel-tests? ,parallel-tests? #:strip-directories #$strip-directories))))
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#: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)) #:system system
(#f ; the default #:guile-for-build guile)))
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
;;; ;;;
;;; 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 ''())
@ -193,7 +181,7 @@ provides a 'CMakeLists.txt' file as its build system."
(make-flags ''()) (make-flags ''())
(out-of-source? #t) (out-of-source? #t)
(build-type "RelWithDebInfo") (build-type "RelWithDebInfo")
(tests? #f) ; nothing can be done (tests? #f) ; nothing can be done
(test-target "test") (test-target "test")
(parallel-build? #t) (parallel-tests? #f) (parallel-build? #t) (parallel-tests? #f)
(validate-runpath? #t) (validate-runpath? #t)
@ -214,77 +202,52 @@ provides a 'CMakeLists.txt' file as its build system."
with INPUTS. This assumes that SOURCE provides a 'CMakeLists.txt' file as its 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
',(map (match-lambda
((name (? derivation? drv) sub ...)
`(,name . ,(apply derivation->output-path drv sub)))
((name path)
`(,name . ,path)))
native-drvs))
(define %build-target-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 (? 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 %build-target-inputs
(((? derivation? source)) (append #$(input-tuples->gexp host-inputs)
(derivation->output-path source)) #+(input-tuples->gexp target-inputs)))
((source)
source)
(source
source))
#:system ,system
#:build ,build
#:target ,target
#:outputs %outputs
#:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:native-search-paths ',(map
search-path-specification->sexp
native-search-paths)
#:phases ,phases
#:configure-flags ,configure-flags
#:make-flags ,make-flags
#:out-of-source? ,out-of-source?
#:build-type ,build-type
#:tests? ,tests?
#:test-target ,test-target
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories))))
(define guile-for-build (define %outputs
(match guile #$(outputs->gexp outputs))
((? 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 (qt-build #:source #+source
#:system system #:system #$system
#:inputs (append native-drvs target-drvs) #:build #$build
#:outputs outputs #:target #$target
#:modules imported-modules #:outputs %outputs
#:guile-for-build guile-for-build)) #:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:native-search-paths '#$(map
search-path-specification->sexp
native-search-paths)
#:phases #$phases
#:configure-flags #$configure-flags
#:make-flags #$make-flags
#:out-of-source? #$out-of-source?
#:build-type #$build-type
#:tests? #$tests?
#:test-target #$test-target
#:parallel-build? #$parallel-build?
#:parallel-tests? #$parallel-tests?
#:validate-runpath? #$validate-runpath?
#:patch-shebangs? #$patch-shebangs?
#:strip-binaries? #$strip-binaries?
#:strip-flags #$strip-flags
#:strip-directories #$strip-directories))))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
(define qt-build-system (define qt-build-system
(build-system (build-system

64
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? search-paths)
#:test-target ,test-target #:inputs #$(input-tuples->gexp inputs)))))
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#: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)) #:system system
(#f ; the default #:guile-for-build guile
(let* ((distro (resolve-interface '(gnu packages commencement))) #:substitutable? substitutable?)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build
#:substitutable? substitutable?))
(define r-build-system (define r-build-system
(build-system (build-system

58
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) search-paths)
source) #:phases #$phases
(source #:system #$system
source)) #:tests? #$tests?
#:search-paths ',(map search-path-specification->sexp #:outputs #$(outputs->gexp outputs)
search-paths) #:inputs #$(input-tuples->gexp inputs)))))
#:phases ,phases
#:system ,system
#:tests? ,tests?
#:outputs %outputs
#: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)) #:system system
(#f ; the default #:guile-for-build guile)))
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(define rakudo-build-system (define rakudo-build-system
(build-system (build-system

88
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,57 +74,43 @@
(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
(phases '(@ (guix build renpy-build-system) source
%standard-phases)) (phases '(@ (guix build renpy-build-system)
(configure-flags ''()) %standard-phases))
(outputs '("out")) (configure-flags ''())
(output "out") (outputs '("out"))
(game "game") (output "out")
(search-paths '()) (game "game")
(system (%current-system)) (search-paths '())
(guile #f) (system (%current-system))
(imported-modules %renpy-build-system-modules) (guile #f)
(modules '((guix build renpy-build-system) (imported-modules %renpy-build-system-modules)
(guix build utils)))) (modules '((guix build renpy-build-system)
(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 search-paths)
#:outputs %outputs #:inputs #$(input-tuples->gexp inputs)))))
#:output ,output
#:game ,game
#:search-paths ',(map search-path-specification->sexp
search-paths)
#: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)) #:system system
(#f ; the default #:guile-for-build guile)))
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(define renpy-build-system (define renpy-build-system
(build-system (build-system

66
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")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:gem-flags ,gem-flags
#:test-target ,test-target
#:tests? ,tests?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(define guile-for-build #$(with-build-variables inputs outputs
(match guile #~(ruby-build #:name #$name
((? package?) #:source #+source
(package-derivation store guile system #:graft? #f)) #:system #$system
(#f #:gem-flags #$gem-flags
(let* ((distro (resolve-interface '(gnu packages commencement))) #:test-target #$test-target
(guile (module-ref distro 'guile-final))) #:tests? #$tests?
(package-derivation store guile system #:graft? #f))))) #:phases #$phases
#:outputs %outputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs))))
(build-expression->derivation store name builder (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
#:inputs inputs system #:graft? #f)))
#:system system (gexp->derivation name build
#:modules imported-modules #:system system
#:outputs outputs #:target #f
#:guile-for-build guile-for-build)) #:modules imported-modules
#:guile-for-build guile)))
(define ruby-build-system (define ruby-build-system
(build-system (build-system

69
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
(scons-build #:name ,name (use-modules #$@modules)
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:scons-flags ,scons-flags
#:system ,system
#:build-targets ,build-targets
#:test-target ,test-target
#:tests? ,tests?
#:install-targets ,install-targets
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(define guile-for-build (scons-build #:name ,name
(match guile #:source #+source
((? package?) #:scons-flags #$scons-flags
(package-derivation store guile system #:graft? #f)) #:system #$system
(#f ; the default #:build-targets #$build-targets
(let* ((distro (resolve-interface '(gnu packages commencement))) #:test-target #$test-target
(guile (module-ref distro 'guile-final))) #:tests? #$tests?
(package-derivation store guile system #:graft? #f))))) #:install-targets #$install-targets
#:phases #$phases
#:outputs (list #$@(map (lambda (name)
#~(cons #$name
(ungexp output name)))
outputs))
#:inputs (map (lambda (tuple)
(apply cons tuple))
'#$inputs)
#:search-paths '#$(map search-path-specification->sexp
search-paths)))))
(build-expression->derivation store name builder (gexp->derivation name builder
#:inputs inputs #:system system
#:system system #:target #f
#:modules imported-modules #:guile-for-build guile))
#:outputs outputs
#:guile-for-build guile-for-build))
(define scons-build-system (define scons-build-system
(build-system (build-system

69
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,43 +142,31 @@ 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 #:system system
((? package?) #:target #f
(package-derivation store guile system #:graft? #f)) #:substitutable? substitutable?))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build
#:substitutable? substitutable?))
(define texlive-build-system (define texlive-build-system
(build-system (build-system

89
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 #:system system
#:graft? #f))) #:target #f
(((? package? p) output) #:modules modules
(derivation->output-path (package-derivation store p system #:allowed-references allowed-references
#:graft? #f) #:guile-for-build guile)))
output))
((? string? output)
output)))
(build-expression->derivation store name builder (define* (trivial-cross-build name
#:inputs inputs
#:system system
#:outputs outputs
#:modules modules
#:allowed-references
(and allowed-references
(map canonicalize-reference
allowed-references))
#:guile-for-build
(guile-for-build store guile system)))
(define* (trivial-cross-build store name
#: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)) #:system system
((? string? output) #:target target
output))) #:modules modules
#:allowed-references allowed-references
(build-expression->derivation store name builder #:guile-for-build guile)))
#:inputs (append native-drvs target-drvs)
#:system system
#:outputs outputs
#:modules modules
#:allowed-references
(and allowed-references
(map canonicalize-reference
allowed-references))
#:guile-for-build
(guile-for-build store guile system)))
(define trivial-build-system (define trivial-build-system
(build-system (build-system

88
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,58 +73,46 @@
(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 ''())
(phases '(@ (guix build waf-build-system) (phases '(@ (guix build waf-build-system)
%standard-phases)) %standard-phases))
(outputs '("out")) (outputs '("out"))
(search-paths '()) (search-paths '())
(system (%current-system)) (system (%current-system))
(guile #f) (guile #f)
(imported-modules %waf-build-system-modules) (imported-modules %waf-build-system-modules)
(modules '((guix build waf-build-system) (modules '((guix build waf-build-system)
(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")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:configure-flags ,configure-flags
#:system ,system
#:test-target ,test-target
#:tests? ,tests?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(define guile-for-build #$(with-build-variables inputs outputs
(match guile #~(waf-build #:name #$name
((? package?) #:source #+source
(package-derivation store guile system #:graft? #f)) #:configure-flags #$configure-flags
(#f ; the default #:system #$system
(let* ((distro (resolve-interface '(gnu packages commencement))) #:test-target #$test-target
(guile (module-ref distro 'guile-final))) #:tests? #$tests?
(package-derivation store guile system #:graft? #f))))) #:phases #$phases
#:outputs %outputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs))))
(build-expression->derivation store name builder (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
#:inputs inputs system #:graft? #f)))
#:system system (gexp->derivation name build
#:modules imported-modules #:system system
#:outputs outputs #:target #f
#:guile-for-build guile-for-build)) #:modules imported-modules
#:guile-for-build guile)))
(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))))))

16
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.")