summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.dir-locals.el1
-rw-r--r--gnu/packages/bootstrap.scm115
-rw-r--r--gnu/packages/commencement.scm3
-rw-r--r--guix/build-system/android-ndk.scm97
-rw-r--r--guix/build-system/ant.scm78
-rw-r--r--guix/build-system/asdf.scm144
-rw-r--r--guix/build-system/cargo.scm78
-rw-r--r--guix/build-system/chicken.scm96
-rw-r--r--guix/build-system/clojure.scm109
-rw-r--r--guix/build-system/cmake.scm211
-rw-r--r--guix/build-system/copy.scm72
-rw-r--r--guix/build-system/dub.scm89
-rw-r--r--guix/build-system/dune.scm85
-rw-r--r--guix/build-system/emacs.scm62
-rw-r--r--guix/build-system/font.scm59
-rw-r--r--guix/build-system/glib-or-gtk.scm105
-rw-r--r--guix/build-system/gnu.scm284
-rw-r--r--guix/build-system/go.scm70
-rw-r--r--guix/build-system/guile.scm170
-rw-r--r--guix/build-system/haskell.scm73
-rw-r--r--guix/build-system/julia.scm57
-rw-r--r--guix/build-system/linux-module.scm164
-rw-r--r--guix/build-system/maven.scm114
-rw-r--r--guix/build-system/meson.scm119
-rw-r--r--guix/build-system/minify.scm56
-rw-r--r--guix/build-system/node.scm60
-rw-r--r--guix/build-system/ocaml.scm89
-rw-r--r--guix/build-system/perl.scm74
-rw-r--r--guix/build-system/python.scm73
-rw-r--r--guix/build-system/qt.scm201
-rw-r--r--guix/build-system/r.scm64
-rw-r--r--guix/build-system/rakudo.scm58
-rw-r--r--guix/build-system/renpy.scm88
-rw-r--r--guix/build-system/ruby.scm66
-rw-r--r--guix/build-system/scons.scm69
-rw-r--r--guix/build-system/texlive.scm71
-rw-r--r--guix/build-system/trivial.scm89
-rw-r--r--guix/build-system/waf.scm88
-rw-r--r--guix/gexp.scm1
-rw-r--r--guix/packages.scm77
-rw-r--r--tests/builders.scm2
-rw-r--r--tests/lint.scm4
-rw-r--r--tests/packages.scm16
43 files changed, 1541 insertions, 2160 deletions
diff --git a/.dir-locals.el b/.dir-locals.el
index 8f07a08eb5b..378071ea67c 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -119,6 +119,7 @@
119 (eval . (put 'with-extensions 'scheme-indent-function 1)) 119 (eval . (put 'with-extensions 'scheme-indent-function 1))
120 (eval . (put 'with-parameters 'scheme-indent-function 1)) 120 (eval . (put 'with-parameters 'scheme-indent-function 1))
121 (eval . (put 'let-system 'scheme-indent-function 1)) 121 (eval . (put 'let-system 'scheme-indent-function 1))
122 (eval . (put 'with-build-variables 'scheme-indent-function 2))
122 123
123 (eval . (put 'with-database 'scheme-indent-function 2)) 124 (eval . (put 'with-database 'scheme-indent-function 2))
124 (eval . (put 'call-with-database 'scheme-indent-function 1)) 125 (eval . (put 'call-with-database 'scheme-indent-function 1))
diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm
index c50e94e891b..c8844a40a8f 100644
--- a/gnu/packages/bootstrap.scm
+++ b/gnu/packages/bootstrap.scm
@@ -32,11 +32,13 @@
32 #:use-module (guix build-system gnu) 32 #:use-module (guix build-system gnu)
33 #:use-module (guix build-system trivial) 33 #:use-module (guix build-system trivial)
34 #:use-module ((guix store) 34 #:use-module ((guix store)
35 #:select (run-with-store add-to-store add-text-to-store)) 35 #:select (%store-monad interned-file text-file store-lift))
36 #:use-module ((guix derivations) 36 #:use-module ((guix derivations)
37 #:select (derivation derivation-input derivation->output-path)) 37 #:select (raw-derivation derivation-input derivation->output-path))
38 #:use-module ((guix utils) #:select (gnu-triplet->nix-system)) 38 #:use-module (guix utils)
39 #:use-module ((guix build utils) #:select (elf-file?))
39 #:use-module ((guix gexp) #:select (lower-object)) 40 #:use-module ((guix gexp) #:select (lower-object))
41 #:use-module (guix monads)
40 #:use-module (guix memoization) 42 #:use-module (guix memoization)
41 #:use-module (guix i18n) 43 #:use-module (guix i18n)
42 #:use-module (srfi srfi-1) 44 #:use-module (srfi srfi-1)
@@ -376,59 +378,58 @@ or false to signal an error."
376 %bootstrap-base-urls)) 378 %bootstrap-base-urls))
377 (sha256 (bootstrap-guile-hash system)))) 379 (sha256 (bootstrap-guile-hash system))))
378 380
379(define (download-bootstrap-guile store system) 381(define (download-bootstrap-guile system)
380 "Return a derivation that downloads the bootstrap Guile tarball for SYSTEM." 382 "Return a derivation that downloads the bootstrap Guile tarball for SYSTEM."
381 (let* ((path (bootstrap-guile-url-path system)) 383 (let* ((path (bootstrap-guile-url-path system))
382 (base (basename path)) 384 (base (basename path))
383 (urls (map (cut string-append <> path) %bootstrap-base-urls))) 385 (urls (map (cut string-append <> path) %bootstrap-base-urls)))
384 (run-with-store store 386 (url-fetch urls 'sha256 (bootstrap-guile-hash system)
385 (url-fetch urls 'sha256 (bootstrap-guile-hash system) 387 #:system system)))
386 #:system system))))
387 388
388(define* (raw-build store name inputs 389(define* (raw-build name inputs
389 #:key outputs system search-paths 390 #:key outputs system search-paths
390 #:allow-other-keys) 391 #:allow-other-keys)
391 (define (->store file) 392 (define (->store file)
392 (run-with-store store 393 (lower-object (bootstrap-executable file system)
393 (lower-object (bootstrap-executable file system) 394 system))
394 system))) 395
395 396 (define (make-guile-wrapper bash guile-real)
396 (let* ((tar (->store "tar")) 397 ;; The following code, run by the bootstrap guile after it is unpacked,
397 (xz (->store "xz")) 398 ;; creates a wrapper for itself to set its load path. This replaces the
398 (mkdir (->store "mkdir")) 399 ;; previous non-portable method based on reading the /proc/self/exe
399 (bash (->store "bash")) 400 ;; symlink.
400 (guile (download-bootstrap-guile store system)) 401 '(begin
401 ;; The following code, run by the bootstrap guile after it is 402 (use-modules (ice-9 match))
402 ;; unpacked, creates a wrapper for itself to set its load path. 403 (match (command-line)
403 ;; This replaces the previous non-portable method based on 404 ((_ out bash)
404 ;; reading the /proc/self/exe symlink. 405 (let ((bin-dir (string-append out "/bin"))
405 (make-guile-wrapper 406 (guile (string-append out "/bin/guile"))
406 '(begin 407 (guile-real (string-append out "/bin/.guile-real"))
407 (use-modules (ice-9 match)) 408 ;; We must avoid using a bare dollar sign in this code,
408 (match (command-line) 409 ;; because it would be interpreted by the shell.
409 ((_ out bash) 410 (dollar (string (integer->char 36))))
410 (let ((bin-dir (string-append out "/bin")) 411 (chmod bin-dir #o755)
411 (guile (string-append out "/bin/guile")) 412 (rename-file guile guile-real)
412 (guile-real (string-append out "/bin/.guile-real")) 413 (call-with-output-file guile
413 ;; We must avoid using a bare dollar sign in this code, 414 (lambda (p)
414 ;; because it would be interpreted by the shell. 415 (format p "\
415 (dollar (string (integer->char 36))))
416 (chmod bin-dir #o755)
417 (rename-file guile guile-real)
418 (call-with-output-file guile
419 (lambda (p)
420 (format p "\
421#!~a 416#!~a
422export GUILE_SYSTEM_PATH=~a/share/guile/2.0 417export GUILE_SYSTEM_PATH=~a/share/guile/2.0
423export GUILE_SYSTEM_COMPILED_PATH=~a/lib/guile/2.0/ccache 418export GUILE_SYSTEM_COMPILED_PATH=~a/lib/guile/2.0/ccache
424exec -a \"~a0\" ~a \"~a@\"\n" 419exec -a \"~a0\" ~a \"~a@\"\n"
425 bash out out dollar guile-real dollar))) 420 bash out out dollar guile-real dollar)))
426 (chmod guile #o555) 421 (chmod guile #o555)
427 (chmod bin-dir #o555)))))) 422 (chmod bin-dir #o555))))))
428 (builder 423
429 (add-text-to-store store 424 (mlet* %store-monad ((tar (->store "tar"))
430 "build-bootstrap-guile.sh" 425 (xz (->store "xz"))
431 (format #f " 426 (mkdir (->store "mkdir"))
427 (bash (->store "bash"))
428 (guile (download-bootstrap-guile system))
429 (wrapper -> (make-guile-wrapper bash guile))
430 (builder
431 (text-file "build-bootstrap-guile.sh"
432 (format #f "
432echo \"unpacking bootstrap Guile to '$out'...\" 433echo \"unpacking bootstrap Guile to '$out'...\"
433~a $out 434~a $out
434cd $out 435cd $out
@@ -441,19 +442,19 @@ $out/bin/guile -c ~s $out ~a
441 442
442# Sanity check. 443# Sanity check.
443$out/bin/guile --version~%" 444$out/bin/guile --version~%"
444 (derivation->output-path mkdir) 445 (derivation->output-path mkdir)
445 (derivation->output-path xz) 446 (derivation->output-path xz)
446 (derivation->output-path tar) 447 (derivation->output-path tar)
447 (format #f "~s" make-guile-wrapper) 448 (object->string wrapper)
448 (derivation->output-path bash))))) 449 (derivation->output-path bash)))))
449 (derivation store name 450 (raw-derivation name
450 (derivation->output-path bash) `(,builder) 451 (derivation->output-path bash) `(,builder)
451 #:system system 452 #:system system
452 #:inputs (map derivation-input 453 #:inputs (map derivation-input
453 (list bash mkdir tar xz guile)) 454 (list bash mkdir tar xz guile))
454 #:sources (list builder) 455 #:sources (list builder)
455 #:env-vars `(("GUILE_TARBALL" 456 #:env-vars `(("GUILE_TARBALL"
456 . ,(derivation->output-path guile)))))) 457 . ,(derivation->output-path guile))))))
457 458
458(define* (make-raw-bag name 459(define* (make-raw-bag name
459 #:key source inputs native-inputs outputs 460 #:key source inputs native-inputs outputs
diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm
index 7c39a84008b..3eba9604476 100644
--- a/gnu/packages/commencement.scm
+++ b/gnu/packages/commencement.scm
@@ -52,6 +52,7 @@
52 #:use-module (gnu packages pkg-config) 52 #:use-module (gnu packages pkg-config)
53 #:use-module (gnu packages rsync) 53 #:use-module (gnu packages rsync)
54 #:use-module (gnu packages xml) 54 #:use-module (gnu packages xml)
55 #:use-module (guix gexp)
55 #:use-module (guix packages) 56 #:use-module (guix packages)
56 #:use-module (guix download) 57 #:use-module (guix download)
57 #:use-module (guix build-system gnu) 58 #:use-module (guix build-system gnu)
@@ -3375,7 +3376,7 @@ exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
3375 ;; if 'allowed-references' were per-output. 3376 ;; if 'allowed-references' were per-output.
3376 (arguments 3377 (arguments
3377 `(#:allowed-references 3378 `(#:allowed-references
3378 ((,gcc-boot0 "lib") 3379 (,(gexp-input gcc-boot0 "lib")
3379 ,(kernel-headers-boot0) 3380 ,(kernel-headers-boot0)
3380 ,static-bash-for-glibc 3381 ,static-bash-for-glibc
3381 ,@(if (hurd-system?) 3382 ,@(if (hurd-system?)
diff --git a/guix/build-system/android-ndk.scm b/guix/build-system/android-ndk.scm
index dbfa626a196..d8896e23057 100644
--- a/guix/build-system/android-ndk.scm
+++ b/guix/build-system/android-ndk.scm
@@ -1,5 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2016 Danny Milosavljevic <dannym@scratchpost.org> 2;;; Copyright © 2016 Danny Milosavljevic <dannym@scratchpost.org>
3;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
3;;; 4;;;
4;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
5;;; 6;;;
@@ -20,7 +21,8 @@
20 #:use-module (guix search-paths) 21 #:use-module (guix search-paths)
21 #:use-module (guix store) 22 #:use-module (guix store)
22 #:use-module (guix utils) 23 #:use-module (guix utils)
23 #:use-module (guix derivations) 24 #:use-module (guix gexp)
25 #:use-module (guix monads)
24 #:use-module (guix packages) 26 #:use-module (guix packages)
25 #:use-module (guix build-system) 27 #:use-module (guix build-system)
26 #:use-module (guix build-system gnu) 28 #:use-module (guix build-system gnu)
@@ -34,62 +36,49 @@
34 (guix build syscalls) 36 (guix build syscalls)
35 ,@%gnu-build-system-modules)) 37 ,@%gnu-build-system-modules))
36 38
37(define* (android-ndk-build store name inputs 39(define* (android-ndk-build name inputs
38 #:key 40 #:key
39 (tests? #t) 41 source
40 (test-target #f) 42 (tests? #t)
41 (phases '(@ (guix build android-ndk-build-system) 43 (test-target #f)
42 %standard-phases)) 44 (phases '(@ (guix build android-ndk-build-system)
43 (outputs '("out")) 45 %standard-phases))
44 (make-flags ''()) 46 (outputs '("out"))
45 (search-paths '()) 47 (make-flags #~'())
46 (system (%current-system)) 48 (search-paths '())
47 (guile #f) 49 (system (%current-system))
48 (imported-modules %android-ndk-build-system-modules) 50 (guile #f)
49 (modules '((guix build android-ndk-build-system) 51 (imported-modules %android-ndk-build-system-modules)
50 (guix build utils)))) 52 (modules '((guix build android-ndk-build-system)
53 (guix build utils))))
51 "Build SOURCE using Android NDK, and with INPUTS." 54 "Build SOURCE using Android NDK, and with INPUTS."
52 (define builder 55 (define builder
53 `(begin 56 (with-imported-modules imported-modules
54 (use-modules ,@modules) 57 #~(begin
55 (android-ndk-build #:name ,name 58 (use-modules #$@modules)
56 #:source ,(match (assoc-ref inputs "source")
57 (((? derivation? source))
58 (derivation->output-path source))
59 ((source)
60 source)
61 (source
62 source))
63 #:system ,system
64 #:test-target ,test-target
65 #:tests? ,tests?
66 #:phases ,phases
67 #:make-flags (cons* "-f"
68 ,(string-append
69 (derivation->output-path
70 (car (assoc-ref inputs "android-build")))
71 "/share/android/build/core/main.mk")
72 ,make-flags)
73 #:outputs %outputs
74 #:search-paths ',(map search-path-specification->sexp
75 search-paths)
76 #:inputs %build-inputs)))
77 59
78 (define guile-for-build 60 (android-ndk-build #:name #$name
79 (match guile 61 #:source #+source
80 ((? package?) 62 #:system #$system
81 (package-derivation store guile system #:graft? #f)) 63 #:test-target #$test-target
82 (#f ; the default 64 #:tests? #$tests?
83 (let* ((distro (resolve-interface '(gnu packages commencement))) 65 #:phases #$phases
84 (guile (module-ref distro 'guile-final))) 66 #:make-flags
85 (package-derivation store guile system #:graft? #f))))) 67 (cons* "-f"
68 #$(file-append (car (assoc-ref inputs
69 "android-build"))
70 "/share/android/build/core/main.mk")
71 #$make-flags)
72 #:outputs #$(outputs->gexp outputs)
73 #:search-paths '#$(map search-path-specification->sexp
74 search-paths)
75 #:inputs #$(input-tuples->gexp inputs)))))
86 76
87 (build-expression->derivation store name builder 77 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
88 #:inputs inputs 78 system #:graft? #f)))
89 #:system system 79 (gexp->derivation name builder
90 #:modules imported-modules 80 #:system system
91 #:outputs outputs 81 #:guile-for-build guile)))
92 #:guile-for-build guile-for-build))
93 82
94(define* (lower name 83(define* (lower name
95 #:key source inputs native-inputs outputs system target 84 #:key source inputs native-inputs outputs system target
@@ -98,7 +87,7 @@
98 "Return a bag for NAME." 87 "Return a bag for NAME."
99 88
100 (define private-keywords 89 (define private-keywords
101 '(#:source #:target #:inputs #:native-inputs #:outputs)) 90 '(#:target #:inputs #:native-inputs #:outputs))
102 91
103 (and (not target) ;; TODO: support cross-compilation 92 (and (not target) ;; TODO: support cross-compilation
104 (bag 93 (bag
diff --git a/guix/build-system/ant.scm b/guix/build-system/ant.scm
index 1809d1f3d2d..cb48c4226c7 100644
--- a/guix/build-system/ant.scm
+++ b/guix/build-system/ant.scm
@@ -1,5 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net> 2;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
3;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
3;;; 4;;;
4;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
5;;; 6;;;
@@ -20,7 +21,8 @@
20 #:use-module (guix store) 21 #:use-module (guix store)
21 #:use-module (guix utils) 22 #:use-module (guix utils)
22 #:use-module (guix packages) 23 #:use-module (guix packages)
23 #:use-module (guix derivations) 24 #:use-module (guix gexp)
25 #:use-module (guix monads)
24 #:use-module (guix search-paths) 26 #:use-module (guix search-paths)
25 #:use-module (guix build-system) 27 #:use-module (guix build-system)
26 #:use-module (guix build-system gnu) 28 #:use-module (guix build-system gnu)
@@ -73,7 +75,7 @@
73 #:rest arguments) 75 #:rest arguments)
74 "Return a bag for NAME." 76 "Return a bag for NAME."
75 (define private-keywords 77 (define private-keywords
76 '(#:source #:target #:jdk #:ant #:zip #:inputs #:native-inputs)) 78 '(#:target #:jdk #:ant #:zip #:inputs #:native-inputs))
77 79
78 (and (not target) ;XXX: no cross-compilation 80 (and (not target) ;XXX: no cross-compilation
79 (bag 81 (bag
@@ -94,8 +96,9 @@
94 (build ant-build) 96 (build ant-build)
95 (arguments (strip-keyword-arguments private-keywords arguments))))) 97 (arguments (strip-keyword-arguments private-keywords arguments)))))
96 98
97(define* (ant-build store name inputs 99(define* (ant-build name inputs
98 #:key 100 #:key
101 source
99 (tests? #t) 102 (tests? #t)
100 (test-target "check") 103 (test-target "check")
101 (configure-flags ''()) 104 (configure-flags ''())
@@ -119,49 +122,34 @@
119 (guix build utils)))) 122 (guix build utils))))
120 "Build SOURCE with INPUTS." 123 "Build SOURCE with INPUTS."
121 (define builder 124 (define builder
122 `(begin 125 (with-imported-modules imported-modules
123 (use-modules ,@modules) 126 #~(begin
124 (ant-build #:name ,name 127 (use-modules #$@modules)
125 #:source ,(match (assoc-ref inputs "source") 128 (ant-build #:name #$name
126 (((? derivation? source)) 129 #:source #+source
127 (derivation->output-path source)) 130 #:make-flags #$make-flags
128 ((source) 131 #:configure-flags #$configure-flags
129 source) 132 #:system #$system
130 (source 133 #:tests? #$tests?
131 source)) 134 #:test-target #$test-target
132 #:make-flags ,make-flags 135 #:build-target #$build-target
133 #:configure-flags ,configure-flags 136 #:jar-name #$jar-name
134 #:system ,system 137 #:main-class #$main-class
135 #:tests? ,tests? 138 #:test-include (list #$@test-include)
136 #:test-target ,test-target 139 #:test-exclude (list #$@test-exclude)
137 #:build-target ,build-target 140 #:source-dir #$source-dir
138 #:jar-name ,jar-name 141 #:test-dir #$test-dir
139 #:main-class ,main-class 142 #:phases #$phases
140 #:test-include (list ,@test-include) 143 #:outputs #$(outputs->gexp outputs)
141 #:test-exclude (list ,@test-exclude) 144 #:search-paths '#$(map search-path-specification->sexp
142 #:source-dir ,source-dir 145 search-paths)
143 #:test-dir ,test-dir 146 #:inputs #$(input-tuples->gexp inputs)))))
144 #:phases ,phases
145 #:outputs %outputs
146 #:search-paths ',(map search-path-specification->sexp
147 search-paths)
148 #:inputs %build-inputs)))
149 147
150 (define guile-for-build 148 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
151 (match guile 149 system #:graft? #f)))
152 ((? package?) 150 (gexp->derivation name builder
153 (package-derivation store guile system #:graft? #f)) 151 #:system system
154 (#f ; the default 152 #:guile-for-build guile)))
155 (let* ((distro (resolve-interface '(gnu packages commencement)))
156 (guile (module-ref distro 'guile-final)))
157 (package-derivation store guile system #:graft? #f)))))
158
159 (build-expression->derivation store name builder
160 #:inputs inputs
161 #:system system
162 #:modules imported-modules
163 #:outputs outputs
164 #:guile-for-build guile-for-build))
165 153
166(define ant-build-system 154(define ant-build-system
167 (build-system 155 (build-system
diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm
index 28403a1960c..5f01d7ccce5 100644
--- a/guix/build-system/asdf.scm
+++ b/guix/build-system/asdf.scm
@@ -1,6 +1,7 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca> 2;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
3;;; Copyright © 2019, 2020 Guillaume Le Vaillant <glv@posteo.net> 3;;; Copyright © 2019, 2020 Guillaume Le Vaillant <glv@posteo.net>
4;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
4;;; 5;;;
5;;; This file is part of GNU Guix. 6;;; This file is part of GNU Guix.
6;;; 7;;;
@@ -22,7 +23,8 @@
22 #:use-module (guix utils) 23 #:use-module (guix utils)
23 #:use-module (guix memoization) 24 #:use-module (guix memoization)
24 #:use-module (guix packages) 25 #:use-module (guix packages)
25 #:use-module (guix derivations) 26 #:use-module (guix gexp)
27 #:use-module (guix monads)
26 #:use-module (guix search-paths) 28 #:use-module (guix search-paths)
27 #:use-module ((guix build utils) 29 #:use-module ((guix build utils)
28 #:select ((package-name->name+version 30 #:select ((package-name->name+version
@@ -92,7 +94,7 @@
92 (build asdf-build/source) 94 (build asdf-build/source)
93 (arguments (strip-keyword-arguments private-keywords arguments))))) 95 (arguments (strip-keyword-arguments private-keywords arguments)))))
94 96
95(define* (asdf-build/source store name inputs 97(define* (asdf-build/source name inputs
96 #:key source outputs 98 #:key source outputs
97 (phases '(@ (guix build asdf-build-system) 99 (phases '(@ (guix build asdf-build-system)
98 %standard-phases/source)) 100 %standard-phases/source))
@@ -102,36 +104,23 @@
102 (imported-modules %asdf-build-system-modules) 104 (imported-modules %asdf-build-system-modules)
103 (modules %asdf-build-modules)) 105 (modules %asdf-build-modules))
104 (define builder 106 (define builder
105 `(begin 107 (with-imported-modules imported-modules
106 (use-modules ,@modules) 108 #~(begin
107 (asdf-build/source #:name ,name 109 (use-modules #$@modules)
108 #:source ,(match (assoc-ref inputs "source") 110 (asdf-build/source #:name #$name
109 (((? derivation? source)) 111 #:source #+source
110 (derivation->output-path source)) 112 #:system #$system
111 ((source) source) 113 #:phases #$phases
112 (source source)) 114 #:outputs #$(outputs->gexp outputs)
113 #:system ,system 115 #:search-paths '#$(map search-path-specification->sexp
114 #:phases ,phases 116 search-paths)
115 #:outputs %outputs 117 #:inputs #$(input-tuples->gexp inputs)))))
116 #:search-paths ',(map search-path-specification->sexp 118
117 search-paths) 119 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
118 #:inputs %build-inputs))) 120 system #:graft? #f)))
119 121 (gexp->derivation name builder
120 (define guile-for-build 122 #:system system
121 (match guile 123 #:guile-for-build guile)))
122 ((? package?)
123 (package-derivation store guile system #:graft? #f))
124 (#f
125 (let* ((distro (resolve-interface '(gnu packages commencement)))
126 (guile (module-ref distro 'guile-final)))
127 (package-derivation store guile system #:graft? #f)))))
128
129 (build-expression->derivation store name builder
130 #:inputs inputs
131 #:system system
132 #:modules imported-modules
133 #:outputs outputs
134 #:guile-for-build guile-for-build))
135 124
136(define* (package-with-build-system from-build-system to-build-system 125(define* (package-with-build-system from-build-system to-build-system
137 from-prefix to-prefix 126 from-prefix to-prefix
@@ -277,19 +266,19 @@ set up using CL source package conventions."
277 (arguments (strip-keyword-arguments private-keywords arguments)))))) 266 (arguments (strip-keyword-arguments private-keywords arguments))))))
278 267
279(define (asdf-build lisp-type) 268(define (asdf-build lisp-type)
280 (lambda* (store name inputs 269 (lambda* (name inputs
281 #:key source outputs 270 #:key source outputs
282 (tests? #t) 271 (tests? #t)
283 (asd-files ''()) 272 (asd-files ''())
284 (asd-systems ''()) 273 (asd-systems ''())
285 (test-asd-file #f) 274 (test-asd-file #f)
286 (phases '(@ (guix build asdf-build-system) 275 (phases '(@ (guix build asdf-build-system)
287 %standard-phases)) 276 %standard-phases))
288 (search-paths '()) 277 (search-paths '())
289 (system (%current-system)) 278 (system (%current-system))
290 (guile #f) 279 (guile #f)
291 (imported-modules %asdf-build-system-modules) 280 (imported-modules %asdf-build-system-modules)
292 (modules %asdf-build-modules)) 281 (modules %asdf-build-modules))
293 282
294 ;; FIXME: The definition of 'systems' is pretty hacky. 283 ;; FIXME: The definition of 'systems' is pretty hacky.
295 ;; Is there a more elegant way to do it? 284 ;; Is there a more elegant way to do it?
@@ -300,48 +289,35 @@ set up using CL source package conventions."
300 (string-drop 289 (string-drop
301 ;; NAME is the value returned from `package-full-name'. 290 ;; NAME is the value returned from `package-full-name'.
302 (hyphen-separated-name->name+version name) 291 (hyphen-separated-name->name+version name)
303 (1+ (string-length lisp-type))))) ; drop the "<lisp>-" prefix. 292 (1+ (string-length lisp-type))))) ; drop the "<lisp>-" prefix.
304 asd-systems)) 293 asd-systems))
305 294
306 (define builder 295 (define builder
307 `(begin 296 (with-imported-modules imported-modules
308 (use-modules ,@modules) 297 #~(begin
309 (parameterize ((%lisp (string-append 298 (use-modules #$@modules)
310 (assoc-ref %build-inputs ,lisp-type) 299 (parameterize ((%lisp (string-append
311 "/bin/" ,lisp-type)) 300 (assoc-ref %build-inputs #$lisp-type)
312 (%lisp-type ,lisp-type)) 301 "/bin/" #$lisp-type))
313 (asdf-build #:name ,name 302 (%lisp-type #$lisp-type))
314 #:source ,(match (assoc-ref inputs "source") 303 (asdf-build #:name #$name
315 (((? derivation? source)) 304 #:source #+source
316 (derivation->output-path source)) 305 #:asd-files #$asd-files
317 ((source) source) 306 #:asd-systems #$systems
318 (source source)) 307 #:test-asd-file #$test-asd-file
319 #:asd-files ,asd-files 308 #:system #$system
320 #:asd-systems ,systems 309 #:tests? #$tests?
321 #:test-asd-file ,test-asd-file 310 #:phases #$phases
322 #:system ,system 311 #:outputs #$(outputs->gexp outputs)
323 #:tests? ,tests? 312 #:search-paths '#$(map search-path-specification->sexp
324 #:phases ,phases 313 search-paths)
325 #:outputs %outputs 314 #:inputs #$(input-tuples->gexp inputs))))))
326 #:search-paths ',(map search-path-specification->sexp 315
327 search-paths) 316 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
328 #:inputs %build-inputs)))) 317 system #:graft? #f)))
329 318 (gexp->derivation name builder
330 (define guile-for-build 319 #:system system
331 (match guile 320 #:guile-for-build guile))))
332 ((? package?)
333 (package-derivation store guile system #:graft? #f))
334 (#f
335 (let* ((distro (resolve-interface '(gnu packages commencement)))
336 (guile (module-ref distro 'guile-final)))
337 (package-derivation store guile system #:graft? #f)))))
338
339 (build-expression->derivation store name builder
340 #:inputs inputs
341 #:system system
342 #:modules imported-modules
343 #:outputs outputs
344 #:guile-for-build guile-for-build)))
345 321
346(define asdf-build-system/sbcl 322(define asdf-build-system/sbcl
347 (build-system 323 (build-system
diff --git a/guix/build-system/cargo.scm b/guix/build-system/cargo.scm
index 0c76ba9355f..d29265de7df 100644
--- a/guix/build-system/cargo.scm
+++ b/guix/build-system/cargo.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013, 2014, 2015, 2016, 2019 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2013, 2014, 2015, 2016, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> 3;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
4;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> 4;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
5;;; Copyright © 2016 David Craven <david@craven.ch> 5;;; Copyright © 2016 David Craven <david@craven.ch>
@@ -26,7 +26,8 @@
26 #:use-module (guix search-paths) 26 #:use-module (guix search-paths)
27 #:use-module (guix store) 27 #:use-module (guix store)
28 #:use-module (guix utils) 28 #:use-module (guix utils)
29 #:use-module (guix derivations) 29 #:use-module (guix gexp)
30 #:use-module (guix monads)
30 #:use-module (guix packages) 31 #:use-module (guix packages)
31 #:use-module (guix build-system) 32 #:use-module (guix build-system)
32 #:use-module (guix build-system gnu) 33 #:use-module (guix build-system gnu)
@@ -71,8 +72,9 @@ to NAME and VERSION."
71 (guix build json) 72 (guix build json)
72 ,@%cargo-utils-modules)) 73 ,@%cargo-utils-modules))
73 74
74(define* (cargo-build store name inputs 75(define* (cargo-build name inputs
75 #:key 76 #:key
77 source
76 (tests? #t) 78 (tests? #t)
77 (test-target #f) 79 (test-target #f)
78 (vendor-dir "guix-vendor") 80 (vendor-dir "guix-vendor")
@@ -94,47 +96,37 @@ to NAME and VERSION."
94 "Build SOURCE using CARGO, and with INPUTS." 96 "Build SOURCE using CARGO, and with INPUTS."
95 97
96 (define builder 98 (define builder
97 `(begin 99 (with-imported-modules imported-modules
98 (use-modules ,@modules) 100 #~(begin
99 (cargo-build #:name ,name 101 (use-modules #$@modules)
100 #:source ,(match (assoc-ref inputs "source")
101 (((? derivation? source))
102 (derivation->output-path source))
103 ((source)
104 source)
105 (source
106 source))
107 #:system ,system
108 #:test-target ,test-target
109 #:vendor-dir ,vendor-dir
110 #:cargo-build-flags ,cargo-build-flags
111 #:cargo-test-flags ,cargo-test-flags
112 #:cargo-package-flags ,cargo-package-flags
113 #:features ,features
114 #:skip-build? ,skip-build?
115 #:install-source? ,install-source?
116 #:tests? ,(and tests? (not skip-build?))
117 #:phases ,phases
118 #:outputs %outputs
119 #:search-paths ',(map search-path-specification->sexp
120 search-paths)
121 #:inputs %build-inputs)))
122 102
123 (define guile-for-build 103 (cargo-build #:name #$name
124 (match guile 104 #:source #+source
125 ((? package?) 105 #:system #$system
126 (package-derivation store guile system #:graft? #f)) 106 #:test-target #$test-target
127 (#f ; the default 107 #:vendor-dir #$vendor-dir
128 (let* ((distro (resolve-interface '(gnu packages commencement))) 108 #:cargo-build-flags #$cargo-build-flags
129 (guile (module-ref distro 'guile-final))) 109 #:cargo-test-flags #$cargo-test-flags
130 (package-derivation store guile system #:graft? #f))))) 110 #:cargo-package-flags #$cargo-package-flags
111 #:features #$features
112 #:skip-build? #$skip-build?
113 #:install-source? #$install-source?
114 #:tests? #$(and tests? (not skip-build?))
115 #:phases #$phases
116 #:outputs (list #$@(map (lambda (name)
117 #~(cons #$name
118 (ungexp output name)))
119 outputs))
120 #:inputs (map (lambda (tuple)
121 (apply cons tuple))
122 '#$inputs)
123 #:search-paths '#$(map search-path-specification->sexp
124 search-paths)))))
131 125
132 (build-expression->derivation store name builder 126 (gexp->derivation name builder
133 #:inputs inputs 127 #:system system
134 #:system system 128 #:target #f
135 #:modules imported-modules 129 #:guile-for-build guile))
136 #:outputs outputs
137 #:guile-for-build guile-for-build))
138 130
139(define (package-cargo-inputs p) 131(define (package-cargo-inputs p)
140 (apply 132 (apply
@@ -253,7 +245,7 @@ any dependent crates. This can be a benefits:
253 "Return a bag for NAME." 245 "Return a bag for NAME."
254 246
255 (define private-keywords 247 (define private-keywords
256 '(#:source #:target #:rust #:inputs #:native-inputs #:outputs 248 '(#:target #:rust #:inputs #:native-inputs #:outputs
257 #:cargo-inputs #:cargo-development-inputs)) 249 #:cargo-inputs #:cargo-development-inputs))
258 250
259 (and (not target) ;; TODO: support cross-compilation 251 (and (not target) ;; TODO: support cross-compilation
diff --git a/guix/build-system/chicken.scm b/guix/build-system/chicken.scm
index 9abae0431ad..0989e7a79ff 100644
--- a/guix/build-system/chicken.scm
+++ b/guix/build-system/chicken.scm
@@ -1,5 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2020 raingloom <raingloom@riseup.net> 2;;; Copyright © 2020 raingloom <raingloom@riseup.net>
3;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
3;;; 4;;;
4;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
5;;; 6;;;
@@ -18,7 +19,9 @@
18 19
19(define-module (guix build-system chicken) 20(define-module (guix build-system chicken)
20 #:use-module (guix utils) 21 #:use-module (guix utils)
21 #:use-module (guix derivations) 22 #:use-module (guix gexp)
23 #:use-module (guix store)
24 #:use-module (guix monads)
22 #:use-module (guix search-paths) 25 #:use-module (guix search-paths)
23 #:use-module (guix build-system) 26 #:use-module (guix build-system)
24 #:use-module (guix build-system gnu) 27 #:use-module (guix build-system gnu)
@@ -47,7 +50,7 @@
47 #:rest arguments) 50 #:rest arguments)
48 "Return a bag for NAME." 51 "Return a bag for NAME."
49 (define private-keywords 52 (define private-keywords
50 '(#:source #:target #:chicken #:inputs #:native-inputs)) 53 '(#:target #:chicken #:inputs #:native-inputs))
51 54
52 ;; TODO: cross-compilation support 55 ;; TODO: cross-compilation support
53 (and (not target) 56 (and (not target)
@@ -69,60 +72,45 @@
69 (build chicken-build) 72 (build chicken-build)
70 (arguments (strip-keyword-arguments private-keywords arguments))))) 73 (arguments (strip-keyword-arguments private-keywords arguments)))))
71 74
72(define* (chicken-build store name inputs 75(define* (chicken-build name inputs
73 #:key 76 #:key
74 (phases '(@ (guix build chicken-build-system) 77 source
75 %standard-phases)) 78 (phases '(@ (guix build chicken-build-system)
76 (outputs '("out")) 79 %standard-phases))
77 (search-paths '()) 80 (outputs '("out"))
78 (egg-name "") 81 (search-paths '())
79 (unpack-path "") 82 (egg-name "")
80 (build-flags ''()) 83 (unpack-path "")
81 (tests? #t) 84 (build-flags ''())
82 (system (%current-system)) 85 (tests? #t)
83 (guile #f) 86 (system (%current-system))
84 (imported-modules %chicken-build-system-modules) 87 (guile #f)
85 (modules '((guix build chicken-build-system) 88 (imported-modules %chicken-build-system-modules)
86 (guix build union) 89 (modules '((guix build chicken-build-system)
87 (guix build utils)))) 90 (guix build union)
91 (guix build utils))))
88 (define builder 92 (define builder
89 `(begin 93 (with-imported-modules imported-modules
90 (use-modules ,@modules) 94 #~(begin
91 (chicken-build #:name ,name 95 (use-modules #$@modules)
92 #:source ,(match (assoc-ref inputs "source") 96 (chicken-build #:name #$name
93 (((? derivation? source)) 97 #:source #+source
94 (derivation->output-path source)) 98 #:system #$system
95 ((source) 99 #:phases #$phases
96 source) 100 #:outputs #$(outputs->gexp outputs)
97 (source 101 #:search-paths '#$(map search-path-specification->sexp
98 source)) 102 search-paths)
99 #:system ,system 103 #:egg-name #$egg-name
100 #:phases ,phases 104 #:unpack-path #$unpack-path
101 #:outputs %outputs 105 #:build-flags #$build-flags
102 #:search-paths ',(map search-path-specification->sexp 106 #:tests? #$tests?
103 search-paths) 107 #:inputs #$(input-tuples->gexp inputs)))))
104 #:egg-name ,egg-name
105 #:unpack-path ,unpack-path
106 #:build-flags ,build-flags
107 #:tests? ,tests?
108 #:inputs %build-inputs)))
109 108
110 (define guile-for-build 109 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
111 (match guile 110 system #:graft? #f)))
112 ((? package?) 111 (gexp->derivation name builder
113 (package-derivation store guile system #:graft? #f)) 112 #:system system
114 (#f ; the default 113 #:guile-for-build guile)))
115 (let* ((distro (resolve-interface '(gnu packages commencement)))
116 (guile (module-ref distro 'guile-final)))
117 (package-derivation store guile system
118 #:graft? #f)))))
119
120 (build-expression->derivation store name builder
121 #:inputs inputs
122 #:system system
123 #:modules imported-modules
124 #:outputs outputs
125 #:guile-for-build guile-for-build))
126 114
127(define chicken-build-system 115(define chicken-build-system
128 (build-system 116 (build-system
diff --git a/guix/build-system/clojure.scm b/guix/build-system/clojure.scm
index 607f67aaec8..e2ad67e3b6f 100644
--- a/guix/build-system/clojure.scm
+++ b/guix/build-system/clojure.scm
@@ -1,6 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com> 2;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
3;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> 3;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org>
4;;; 4;;;
5;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
6;;; 6;;;
@@ -25,7 +25,9 @@
25 #:select (standard-packages) 25 #:select (standard-packages)
26 #:prefix gnu:) 26 #:prefix gnu:)
27 27
28 #:use-module (guix derivations) 28 #:use-module (guix gexp)
29 #:use-module (guix store)
30 #:use-module (guix monads)
29 #:use-module (guix packages) 31 #:use-module (guix packages)
30 #:use-module ((guix search-paths) 32 #:use-module ((guix search-paths)
31 #:select 33 #:select
@@ -102,26 +104,9 @@
102 (arguments (strip-keyword-arguments private-keywords 104 (arguments (strip-keyword-arguments private-keywords
103 arguments)))))) 105 arguments))))))
104 106
105(define-with-docs source->output-path 107(define* (clojure-build name inputs
106 "Convert source input to output path."
107 (match-lambda
108 (((? derivation? source))
109 (derivation->output-path source))
110 ((source)
111 source)
112 (source
113 source)))
114
115(define-with-docs maybe-guile->guile
116 "Find the right guile."
117 (match-lambda
118 ((and maybe-guile (? package?))
119 maybe-guile)
120 (#f ; default
121 (@* (gnu packages commencement) guile-final))))
122
123(define* (clojure-build store name inputs
124 #:key 108 #:key
109 source
125 (source-dirs `',%source-dirs) 110 (source-dirs `',%source-dirs)
126 (test-dirs `',%test-dirs) 111 (test-dirs `',%test-dirs)
127 (compile-dir %compile-dir) 112 (compile-dir %compile-dir)
@@ -133,7 +118,7 @@
133 (aot-include `',%aot-include) 118 (aot-include `',%aot-include)
134 (aot-exclude `',%aot-exclude) 119 (aot-exclude `',%aot-exclude)
135 120
136 doc-dirs ; no sensible default 121 doc-dirs ; no sensible default
137 (doc-regex %doc-regex) 122 (doc-regex %doc-regex)
138 123
139 (tests? %tests?) 124 (tests? %tests?)
@@ -149,48 +134,44 @@
149 (imported-modules %clojure-build-system-modules) 134 (imported-modules %clojure-build-system-modules)
150 (modules %default-modules)) 135 (modules %default-modules))
151 "Build SOURCE with INPUTS." 136 "Build SOURCE with INPUTS."
152 (let ((builder `(begin 137 (define builder
153 (use-modules ,@modules) 138 (with-imported-modules imported-modules
154 (clojure-build #:name ,name 139 #~(begin
155 #:source ,(source->output-path 140 (use-modules #$@modules)
156 (assoc-ref inputs "source")) 141
157 142 (clojure-build #:name #$name
158 #:source-dirs ,source-dirs 143 #:source #+source
159 #:test-dirs ,test-dirs 144
160 #:compile-dir ,compile-dir 145 #:source-dirs #$source-dirs
161 146 #:test-dirs #$test-dirs
162 #:jar-names ,jar-names 147 #:compile-dir #$compile-dir
163 #:main-class ,main-class 148
164 #:omit-source? ,omit-source? 149 #:jar-names #$jar-names
165 150 #:main-class #$main-class
166 #:aot-include ,aot-include 151 #:omit-source? #$omit-source?
167 #:aot-exclude ,aot-exclude 152
168 153 #:aot-include #$aot-include
169 #:doc-dirs ,doc-dirs 154 #:aot-exclude #$aot-exclude
170 #:doc-regex ,doc-regex 155
171 156 #:doc-dirs #$doc-dirs
172 #:tests? ,tests? 157 #:doc-regex #$doc-regex
173 #:test-include ,test-include 158
174 #:test-exclude ,test-exclude 159 #:tests? #$tests?
175 160 #:test-include #$test-include
176 #:phases ,phases 161 #:test-exclude #$test-exclude
177 #:outputs %outputs 162
178 #:search-paths ',(map search-path-spec->sexp 163 #:phases #$phases
179 search-paths) 164 #:outputs #$(outputs->gexp outputs)
180 #:system ,system 165 #:search-paths '#$(map search-path-spec->sexp
181 #:inputs %build-inputs))) 166 search-paths)
182 167 #:system #$system
183 (guile-for-build (package-derivation store 168 #:inputs #$(input-tuples->gexp inputs)))))
184 (maybe-guile->guile guile) 169
185 system 170 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
186 #:graft? #f))) 171 system #:graft? #f)))
187 172 (gexp->derivation name builder
188 (build-expression->derivation store name builder 173 #:system system
189 #:inputs inputs 174 #:guile-for-build guile)))
190 #:system system
191 #:modules imported-modules
192 #:outputs outputs
193 #:guile-for-build guile-for-build)))
194 175
195(define clojure-build-system 176(define clojure-build-system
196 (build-system 177 (build-system
diff --git a/guix/build-system/cmake.scm b/guix/build-system/cmake.scm
index f590b6ea422..f9ac2befc9f 100644
--- a/guix/build-system/cmake.scm
+++ b/guix/build-system/cmake.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013, 2014, 2015, 2020 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2013, 2014, 2015, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> 3;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
4;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> 4;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
5;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il> 5;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
@@ -21,7 +21,9 @@
21 21
22(define-module (guix build-system cmake) 22(define-module (guix build-system cmake)
23 #:use-module (guix store) 23 #:use-module (guix store)
24 #:use-module (guix gexp)
24 #:use-module (guix utils) 25 #:use-module (guix utils)
26 #:use-module (guix monads)
25 #:use-module (guix derivations) 27 #:use-module (guix derivations)
26 #:use-module (guix search-paths) 28 #:use-module (guix search-paths)
27 #:use-module (guix build-system) 29 #:use-module (guix build-system)
@@ -61,7 +63,7 @@
61 #:rest arguments) 63 #:rest arguments)
62 "Return a bag for NAME." 64 "Return a bag for NAME."
63 (define private-keywords 65 (define private-keywords
64 `(#:source #:cmake #:inputs #:native-inputs #:outputs 66 `(#:cmake #:inputs #:native-inputs
65 ,@(if target '() '(#:target)))) 67 ,@(if target '() '(#:target))))
66 68
67 (bag 69 (bag
@@ -95,8 +97,8 @@
95 (build (if target cmake-cross-build cmake-build)) 97 (build (if target cmake-cross-build cmake-build))
96 (arguments (strip-keyword-arguments private-keywords arguments)))) 98 (arguments (strip-keyword-arguments private-keywords arguments))))
97 99
98(define* (cmake-build store name inputs 100(define* (cmake-build name inputs
99 #:key (guile #f) 101 #:key guile source
100 (outputs '("out")) (configure-flags ''()) 102 (outputs '("out")) (configure-flags ''())
101 (search-paths '()) 103 (search-paths '())
102 (make-flags ''()) 104 (make-flags ''())
@@ -120,62 +122,51 @@
120 (guix build utils)))) 122 (guix build utils))))
121 "Build SOURCE using CMAKE, and with INPUTS. This assumes that SOURCE 123 "Build SOURCE using CMAKE, and with INPUTS. This assumes that SOURCE
122provides a 'CMakeLists.txt' file as its build system." 124provides a 'CMakeLists.txt' file as its build system."
123 (define builder 125 (define build
124 `(begin 126 (with-imported-modules imported-modules
125 (use-modules ,@modules) 127 #~(begin
126 (cmake-build #:source ,(match (assoc-ref inputs "source") 128 (use-modules #$@modules)
127 (((? derivation? source))
128 (derivation->output-path source))
129 ((source)
130 source)
131 (source
132 source))
133 #:system ,system
134 #:outputs %outputs
135 #:inputs %build-inputs
136 #:search-paths ',(map search-path-specification->sexp
137 search-paths)
138 #:phases ,phases
139 #:configure-flags ,configure-flags
140 #:make-flags ,make-flags
141 #:out-of-source? ,out-of-source?
142 #:build-type ,build-type
143 #:tests? ,tests?
144 #:test-target ,test-target
145 #:parallel-build? ,parallel-build?
146 #:parallel-tests? ,parallel-tests?
147 #:validate-runpath? ,validate-runpath?
148 #:patch-shebangs? ,patch-shebangs?
149 #:strip-binaries? ,strip-binaries?
150 #:strip-flags ,strip-flags
151 #:strip-directories ,strip-directories)))
152 129
153 (define guile-for-build 130 #$(with-build-variables inputs outputs
154 (match guile 131 #~(cmake-build #:source #+source
155 ((? package?) 132 #:system #$system
156 (package-derivation store guile system #:graft? #f)) 133 #:outputs %outputs
157 (#f ; the default 134 #:inputs %build-inputs
158 (let* ((distro (resolve-interface '(gnu packages commencement))) 135 #:search-paths '#$(map search-path-specification->sexp
159 (guile (module-ref distro 'guile-final))) 136 search-paths)
160 (package-derivation store guile system #:graft? #f))))) 137 #:phases #$phases
138 #:configure-flags #$configure-flags
139 #:make-flags #$make-flags
140 #:out-of-source? #$out-of-source?
141 #:build-type #$build-type
142 #:tests? #$tests?
143 #:test-target #$test-target
144 #:parallel-build? #$parallel-build?
145 #:parallel-tests? #$parallel-tests?
146 #:validate-runpath? #$validate-runpath?
147 #:patch-shebangs? #$patch-shebangs?
148 #:strip-binaries? #$strip-binaries?
149 #:strip-flags #$strip-flags
150 #:strip-directories #$strip-directories)))))
161 151
162 (build-expression->derivation store name builder 152 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
163 #:system system 153 system #:graft? #f)))
164 #:inputs inputs 154 (gexp->derivation name build
165 #:modules imported-modules 155 #:system system
166 #:outputs outputs 156 #:target #f
167 #:substitutable? substitutable? 157 #:substitutable? substitutable?
168 #:guile-for-build guile-for-build)) 158 #:guile-for-build guile)))
169 159
170 160
171;;; 161;;;
172;;; Cross-compilation. 162;;; Cross-compilation.
173;;; 163;;;
174 164
175(define* (cmake-cross-build store name 165(define* (cmake-cross-build name
176 #:key 166 #:key
177 target native-drvs target-drvs 167 target
178 (guile #f) 168 build-inputs target-inputs host-inputs
169 source guile
179 (outputs '("out")) 170 (outputs '("out"))
180 (configure-flags ''()) 171 (configure-flags ''())
181 (search-paths '()) 172 (search-paths '())
@@ -205,78 +196,60 @@ provides a 'CMakeLists.txt' file as its build system."
205with INPUTS. This assumes that SOURCE provides a 'CMakeLists.txt' file as its 196with INPUTS. This assumes that SOURCE provides a 'CMakeLists.txt' file as its
206build system." 197build system."
207 (define builder 198 (define builder
208 `(begin 199 (with-imported-modules imported-modules
209 (use-modules ,@modules) 200 #~(begin
210 (let () 201 (use-modules #$@(sexp->gexp modules))
211 (define %build-host-inputs 202
212 ',(map (match-lambda 203 (define %build-host-inputs
213 ((name (? derivation? drv) sub ...) 204 (map (lambda (tuple)
214 `(,name . ,(apply derivation->output-path drv sub))) 205 (apply cons tuple))
215 ((name path) 206 '#+(append build-inputs target-inputs)))
216 `(,name . ,path)))
217 native-drvs))
218 207
219 (define %build-target-inputs 208 (define %build-target-inputs
220 ',(map (match-lambda 209 (map (lambda (tuple)
221 ((name (? derivation? drv) sub ...) 210 (apply cons tuple))
222 `(,name . ,(apply derivation->output-path drv sub))) 211 '#$host-inputs))
223 ((name (? package? pkg) sub ...)
224 (let ((drv (package-cross-derivation store pkg
225 target system)))
226 `(,name . ,(apply derivation->output-path drv sub))))
227 ((name path)
228 `(,name . ,path)))
229 target-drvs))
230 212
231 (cmake-build #:source ,(match (assoc-ref native-drvs "source") 213 (define %outputs
232 (((? derivation? source)) 214 (list #$@(map (lambda (name)
233 (derivation->output-path source)) 215 #~(cons #$name
234 ((source) 216 (ungexp output name)))
235 source) 217 outputs)))
236 (source
237 source))
238 #:system ,system
239 #:build ,build
240 #:target ,target
241 #:outputs %outputs
242 #:inputs %build-target-inputs
243 #:native-inputs %build-host-inputs
244 #:search-paths ',(map search-path-specification->sexp
245 search-paths)
246 #:native-search-paths ',(map
247 search-path-specification->sexp
248 native-search-paths)
249 #:phases ,phases
250 #:configure-flags ,configure-flags
251 #:make-flags ,make-flags
252 #:out-of-source? ,out-of-source?
253 #:build-type ,build-type
254 #:tests? ,tests?
255 #:test-target ,test-target
256 #:parallel-build? ,parallel-build?
257 #:parallel-tests? ,parallel-tests?
258 #:validate-runpath? ,validate-runpath?
259 #:patch-shebangs? ,patch-shebangs?
260 #:strip-binaries? ,strip-binaries?
261 #:strip-flags ,strip-flags
262 #:strip-directories ,strip-directories))))
263 218
264 (define guile-for-build 219 (cmake-build #:source #+source
265 (match guile 220 #:system #$system
266 ((? package?) 221 #:build #$build
267 (package-derivation store guile system #:graft? #f)) 222 #:target #$target
268 (#f ; the default 223 #:outputs %outputs
269 (let* ((distro (resolve-interface '(gnu packages commencement))) 224 #:inputs %build-target-inputs
270 (guile (module-ref distro 'guile-final))) 225 #:native-inputs %build-host-inputs
271 (package-derivation store guile system #:graft? #f))))) 226 #:search-paths '#$(map search-path-specification->sexp
227 search-paths)
228 #:native-search-paths '#$(map
229 search-path-specification->sexp
230 native-search-paths)
231 #:phases #$phases
232 #:configure-flags #$configure-flags
233 #:make-flags #$make-flags
234 #:out-of-source? #$out-of-source?
235 #:build-type #$build-type
236 #:tests? #$tests?
237 #:test-target #$test-target
238 #:parallel-build? #$parallel-build?
239 #:parallel-tests? #$parallel-tests?
240 #:validate-runpath? #$validate-runpath?
241 #:patch-shebangs? #$patch-shebangs?
242 #:strip-binaries? #$strip-binaries?
243 #:strip-flags #$strip-flags
244 #:strip-directories #$strip-directories))))
272 245
273 (build-expression->derivation store name builder 246 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
274 #:system system 247 system #:graft? #f)))
275 #:inputs (append native-drvs target-drvs) 248 (gexp->derivation name builder
276 #:outputs outputs 249 #:system system
277 #:modules imported-modules 250 #:target target
278 #:substitutable? substitutable? 251 #:substitutable? substitutable?
279 #:guile-for-build guile-for-build)) 252 #:guile-for-build guile)))
280 253
281(define cmake-build-system 254(define cmake-build-system
282 (build-system 255 (build-system
diff --git a/guix/build-system/copy.scm b/guix/build-system/copy.scm
index d1bf8fb6547..8dea0b4c6bb 100644
--- a/guix/build-system/copy.scm
+++ b/guix/build-system/copy.scm
@@ -1,6 +1,7 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu> 2;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
3;;; Copyright © 2020 Pierre Neidhardt <mail@ambrevar.xyz> 3;;; Copyright © 2020 Pierre Neidhardt <mail@ambrevar.xyz>
4;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
4;;; 5;;;
5;;; This file is part of GNU Guix. 6;;; This file is part of GNU Guix.
6;;; 7;;;
@@ -20,7 +21,8 @@
20(define-module (guix build-system copy) 21(define-module (guix build-system copy)
21 #:use-module (guix store) 22 #:use-module (guix store)
22 #:use-module (guix utils) 23 #:use-module (guix utils)
23 #:use-module (guix derivations) 24 #:use-module (guix gexp)
25 #:use-module (guix monads)
24 #:use-module (guix search-paths) 26 #:use-module (guix search-paths)
25 #:use-module (guix build-system) 27 #:use-module (guix build-system)
26 #:use-module (guix build-system gnu) 28 #:use-module (guix build-system gnu)
@@ -59,7 +61,7 @@
59 #:rest arguments) 61 #:rest arguments)
60 "Return a bag for NAME from the given arguments." 62 "Return a bag for NAME from the given arguments."
61 (define private-keywords 63 (define private-keywords
62 '(#:source #:target #:inputs #:native-inputs)) 64 '(#:target #:inputs #:native-inputs))
63 65
64 (bag 66 (bag
65 (name name) 67 (name name)
@@ -75,8 +77,9 @@
75 (build copy-build) 77 (build copy-build)
76 (arguments (strip-keyword-arguments private-keywords arguments)))) 78 (arguments (strip-keyword-arguments private-keywords arguments))))
77 79
78(define* (copy-build store name inputs 80(define* (copy-build name inputs
79 #:key (guile #f) 81 #:key
82 guile source
80 (outputs '("out")) 83 (outputs '("out"))
81 (install-plan ''(("." "./"))) 84 (install-plan ''(("." "./")))
82 (search-paths '()) 85 (search-paths '())
@@ -90,49 +93,38 @@
90 (phases '(@ (guix build copy-build-system) 93 (phases '(@ (guix build copy-build-system)
91 %standard-phases)) 94 %standard-phases))
92 (system (%current-system)) 95 (system (%current-system))
96 (target #f)
93 (imported-modules %copy-build-system-modules) 97 (imported-modules %copy-build-system-modules)
94 (modules '((guix build copy-build-system) 98 (modules '((guix build copy-build-system)
95 (guix build utils)))) 99 (guix build utils))))
96 "Build SOURCE using INSTALL-PLAN, and with INPUTS." 100 "Build SOURCE using INSTALL-PLAN, and with INPUTS."
97 (define builder 101 (define builder
98 `(begin 102 (with-imported-modules imported-modules
99 (use-modules ,@modules) 103 #~(begin
100 (copy-build #:source ,(match (assoc-ref inputs "source") 104 (use-modules #$@modules)
101 (((? derivation? source))
102 (derivation->output-path source))
103 ((source)
104 source)
105 (source
106 source))
107 #:system ,system
108 #:outputs %outputs
109 #:inputs %build-inputs
110 #:install-plan ,install-plan
111 #:search-paths ',(map search-path-specification->sexp
112 search-paths)
113 #:phases ,phases
114 #:out-of-source? ,out-of-source?
115 #:validate-runpath? ,validate-runpath?
116 #:patch-shebangs? ,patch-shebangs?
117 #:strip-binaries? ,strip-binaries?
118 #:strip-flags ,strip-flags
119 #:strip-directories ,strip-directories)))
120 105
121 (define guile-for-build 106 #$(with-build-variables inputs outputs
122 (match guile 107 #~(copy-build #:source #+source
123 ((? package?) 108 #:system #$system
124 (package-derivation store guile system #:graft? #f)) 109 #:outputs %outputs
125 (#f ; the default 110 #:inputs %build-inputs
126 (let* ((distro (resolve-interface '(gnu packages commencement))) 111 #:install-plan #$install-plan
127 (guile (module-ref distro 'guile-final))) 112 #:search-paths '#$(map search-path-specification->sexp
128 (package-derivation store guile system #:graft? #f))))) 113 search-paths)
114 #:phases #$phases
115 #:out-of-source? #$out-of-source?
116 #:validate-runpath? #$validate-runpath?
117 #:patch-shebangs? #$patch-shebangs?
118 #:strip-binaries? #$strip-binaries?
119 #:strip-flags #$strip-flags
120 #:strip-directories #$strip-directories)))))
129 121
130 (build-expression->derivation store name builder 122 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
131 #:system system 123 system #:graft? #f)))
132 #:inputs inputs 124 (gexp->derivation name builder
133 #:modules imported-modules 125 #:system system
134 #:outputs outputs 126 #:target #f
135 #:guile-for-build guile-for-build)) 127 #:guile-for-build guile)))
136 128
137(define copy-build-system 129(define copy-build-system
138 (build-system 130 (build-system
diff --git a/guix/build-system/dub.scm b/guix/build-system/dub.scm
index 5a31a2f51a0..58a72fe8288 100644
--- a/guix/build-system/dub.scm
+++ b/guix/build-system/dub.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2013, 2014, 2015, 2016, 2021 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> 3;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
4;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> 4;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
5;;; Copyright © 2016 David Craven <david@craven.ch> 5;;; Copyright © 2016 David Craven <david@craven.ch>
@@ -24,7 +24,8 @@
24 #:use-module (guix search-paths) 24 #:use-module (guix search-paths)
25 #:use-module (guix store) 25 #:use-module (guix store)
26 #:use-module (guix utils) 26 #:use-module (guix utils)
27 #:use-module (guix derivations) 27 #:use-module (guix gexp)
28 #:use-module (guix monads)
28 #:use-module (guix packages) 29 #:use-module (guix packages)
29 #:use-module (guix build-system) 30 #:use-module (guix build-system)
30 #:use-module (guix build-system gnu) 31 #:use-module (guix build-system gnu)
@@ -56,57 +57,43 @@
56 (guix build syscalls) 57 (guix build syscalls)
57 ,@%gnu-build-system-modules)) 58 ,@%gnu-build-system-modules))
58 59
59(define* (dub-build store name inputs 60(define* (dub-build name inputs
60 #:key 61 #:key
61 (tests? #t) 62 source
62 (test-target #f) 63 (tests? #t)
63 (dub-build-flags ''()) 64 (test-target #f)
64 (phases '(@ (guix build dub-build-system) 65 (dub-build-flags ''())
65 %standard-phases)) 66 (phases '(@ (guix build dub-build-system)
66 (outputs '("out")) 67 %standard-phases))
67 (search-paths '()) 68 (outputs '("out"))
68 (system (%current-system)) 69 (search-paths '())
69 (guile #f) 70 (system (%current-system))
70 (imported-modules %dub-build-system-modules) 71 (guile #f)
71 (modules '((guix build dub-build-system) 72 (imported-modules %dub-build-system-modules)
72 (guix build utils)))) 73 (modules '((guix build dub-build-system)
74 (guix build utils))))
73 "Build SOURCE using DUB, and with INPUTS." 75 "Build SOURCE using DUB, and with INPUTS."
74 (define builder 76 (define builder
75 `(begin 77 (with-imported-modules imported-modules
76 (use-modules ,@modules) 78 #~(begin
77 (dub-build #:name ,name 79 (use-modules #$@modules)
78 #:source ,(match (assoc-ref inputs "source") 80 (dub-build #:name #$name
79 (((? derivation? source)) 81 #:source #+source
80 (derivation->output-path source)) 82 #:system #$system
81 ((source) 83 #:test-target #$test-target
82 source) 84 #:dub-build-flags #$dub-build-flags
83 (source 85 #:tests? #$tests?
84 source)) 86 #:phases #$phases
85 #:system ,system 87 #:outputs #$(outputs->gexp outputs)
86 #:test-target ,test-target 88 #:search-paths '#$(map search-path-specification->sexp
87 #:dub-build-flags ,dub-build-flags 89 search-paths)
88 #:tests? ,tests? 90 #:inputs #$(input-tuples->gexp inputs)))))
89 #:phases ,phases
90 #:outputs %outputs
91 #:search-paths ',(map search-path-specification->sexp
92 search-paths)
93 #:inputs %build-inputs)))
94 91
95 (define guile-for-build 92 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
96 (match guile 93 system #:graft? #f)))
97 ((? package?) 94 (gexp->derivation name builder
98 (package-derivation store guile system #:graft? #f)) 95 #:system system
99 (#f ; the default 96 #:guile-for-build guile)))
100 (let* ((distro (resolve-interface '(gnu packages commencement)))
101 (guile (module-ref distro 'guile-final)))
102 (package-derivation store guile system #:graft? #f)))))
103
104 (build-expression->derivation store name builder
105 #:inputs inputs
106 #:system system
107 #:modules imported-modules
108 #:outputs outputs
109 #:guile-for-build guile-for-build))
110 97
111(define* (lower name 98(define* (lower name
112 #:key source inputs native-inputs outputs system target 99 #:key source inputs native-inputs outputs system target
@@ -118,7 +105,7 @@
118 "Return a bag for NAME." 105 "Return a bag for NAME."
119 106
120 (define private-keywords 107 (define private-keywords
121 '(#:source #:target #:ldc #:dub #:pkg-config #:inputs #:native-inputs #:outputs)) 108 '(#:target #:ldc #:dub #:pkg-config #:inputs #:native-inputs #:outputs))
122 109
123 (and (not target) ;; TODO: support cross-compilation 110 (and (not target) ;; TODO: support cross-compilation
124 (bag 111 (bag
diff --git a/guix/build-system/dune.scm b/guix/build-system/dune.scm
index 6a2f3d16dec..8c33e096f59 100644
--- a/guix/build-system/dune.scm
+++ b/guix/build-system/dune.scm
@@ -1,6 +1,7 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu> 2;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu>
3;;; Copyright © 2017 Ben Woodcroft <donttrustben@gmail.com> 3;;; Copyright © 2017 Ben Woodcroft <donttrustben@gmail.com>
4;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
4;;; 5;;;
5;;; This file is part of GNU Guix. 6;;; This file is part of GNU Guix.
6;;; 7;;;
@@ -20,7 +21,7 @@
20(define-module (guix build-system dune) 21(define-module (guix build-system dune)
21 #:use-module (guix store) 22 #:use-module (guix store)
22 #:use-module (guix utils) 23 #:use-module (guix utils)
23 #:use-module (guix derivations) 24 #:use-module (guix gexp)
24 #:use-module (guix search-paths) 25 #:use-module (guix search-paths)
25 #:use-module (guix build-system) 26 #:use-module (guix build-system)
26 #:use-module ((guix build-system gnu) #:prefix gnu:) 27 #:use-module ((guix build-system gnu) #:prefix gnu:)
@@ -60,7 +61,7 @@
60 #:rest arguments) 61 #:rest arguments)
61 "Return a bag for NAME." 62 "Return a bag for NAME."
62 (define private-keywords 63 (define private-keywords
63 '(#:source #:target #:dune #:findlib #:ocaml #:inputs #:native-inputs)) 64 '(#:target #:dune #:findlib #:ocaml #:inputs #:native-inputs))
64 65
65 (and (not target) ;XXX: no cross-compilation 66 (and (not target) ;XXX: no cross-compilation
66 (let ((base (ocaml:lower name 67 (let ((base (ocaml:lower name
@@ -80,8 +81,9 @@
80 (build dune-build) 81 (build dune-build)
81 (arguments (strip-keyword-arguments private-keywords arguments)))))) 82 (arguments (strip-keyword-arguments private-keywords arguments))))))
82 83
83(define* (dune-build store name inputs 84(define* (dune-build name inputs
84 #:key (guile #f) 85 #:key
86 guile source
85 (outputs '("out")) 87 (outputs '("out"))
86 (search-paths '()) 88 (search-paths '())
87 (build-flags ''()) 89 (build-flags ''())
@@ -107,50 +109,39 @@
107 "Build SOURCE using OCAML, and with INPUTS. This assumes that SOURCE 109 "Build SOURCE using OCAML, and with INPUTS. This assumes that SOURCE
108provides a 'setup.ml' file as its build system." 110provides a 'setup.ml' file as its build system."
109 (define builder 111 (define builder
110 `(begin 112 (with-imported-modules imported-modules
111 (use-modules ,@modules) 113 #~(begin
112 (dune-build #:source ,(match (assoc-ref inputs "source") 114 (use-modules #$@modules)
113 (((? derivation? source)) 115 (dune-build #:source #$source
114 (derivation->output-path source)) 116 #:system #$system
115 ((source) 117 #:outputs (list #$@(map (lambda (name)
116 source) 118 #~(cons #$name
117 (source 119 (ungexp output name)))
118 source)) 120 outputs))
119 #:system ,system 121 #:inputs (map (lambda (tuple)
120 #:outputs %outputs 122 (apply cons tuple))
121 #:inputs %build-inputs 123 '#$inputs)
122 #:search-paths ',(map search-path-specification->sexp 124 #:search-paths '#$(map search-path-specification->sexp
123 search-paths) 125 search-paths)
124 #:phases ,phases 126 #:phases #$phases
125 #:test-flags ,test-flags 127 #:test-flags #$test-flags
126 #:build-flags ,build-flags 128 #:build-flags #$build-flags
127 #:out-of-source? ,out-of-source? 129 #:out-of-source? #$out-of-source?
128 #:jbuild? ,jbuild? 130 #:jbuild? #$jbuild?
129 #:package ,package 131 #:package #$package
130 #:tests? ,tests? 132 #:tests? #$tests?
131 #:test-target ,test-target 133 #:test-target #$test-target
132 #:install-target ,install-target 134 #:install-target #$install-target
133 #:validate-runpath? ,validate-runpath? 135 #:validate-runpath? #$validate-runpath?
134 #:patch-shebangs? ,patch-shebangs? 136 #:patch-shebangs? #$patch-shebangs?
135 #:strip-binaries? ,strip-binaries? 137 #:strip-binaries? #$strip-binaries?
136 #:strip-flags ,strip-flags 138 #:strip-flags #$strip-flags
137 #:strip-directories ,strip-directories))) 139 #:strip-directories #$strip-directories))))
138 140
139 (define guile-for-build 141 (gexp->derivation name builder
140 (match guile 142 #:system system
141 ((? package?) 143 #:target #f
142 (package-derivation store guile system #:graft? #f)) 144 #:guile-for-build guile))
143 (#f ; the default
144 (let* ((distro (resolve-interface '(gnu packages commencement)))
145 (guile (module-ref distro 'guile-final)))
146 (package-derivation store guile system #:graft? #f)))))
147
148 (build-expression->derivation store name builder
149 #:system system
150 #:inputs inputs
151 #:modules imported-modules
152 #:outputs outputs
153 #:guile-for-build guile-for-build))
154 145
155(define dune-build-system 146(define dune-build-system
156 (build-system 147 (build-system
diff --git a/guix/build-system/emacs.scm b/guix/build-system/emacs.scm
index ac05ff420eb..0a8f828b3d8 100644
--- a/guix/build-system/emacs.scm
+++ b/guix/build-system/emacs.scm
@@ -23,7 +23,8 @@
23 #:use-module (guix store) 23 #:use-module (guix store)
24 #:use-module (guix utils) 24 #:use-module (guix utils)
25 #:use-module (guix packages) 25 #:use-module (guix packages)
26 #:use-module (guix derivations) 26 #:use-module (guix gexp)
27 #:use-module (guix monads)
27 #:use-module (guix search-paths) 28 #:use-module (guix search-paths)
28 #:use-module (guix build-system) 29 #:use-module (guix build-system)
29 #:use-module (guix build-system gnu) 30 #:use-module (guix build-system gnu)
@@ -81,7 +82,7 @@
81 (build emacs-build) 82 (build emacs-build)
82 (arguments (strip-keyword-arguments private-keywords arguments))))) 83 (arguments (strip-keyword-arguments private-keywords arguments)))))
83 84
84(define* (emacs-build store name inputs 85(define* (emacs-build name inputs
85 #:key source 86 #:key source
86 (tests? #f) 87 (tests? #f)
87 (parallel-tests? #t) 88 (parallel-tests? #t)
@@ -100,43 +101,28 @@
100 (guix build emacs-utils)))) 101 (guix build emacs-utils))))
101 "Build SOURCE using EMACS, and with INPUTS." 102 "Build SOURCE using EMACS, and with INPUTS."
102 (define builder 103 (define builder
103 `(begin 104 (with-imported-modules imported-modules
104 (use-modules ,@modules) 105 #~(begin
105 (emacs-build #:name ,name 106 (use-modules #$@modules)
106 #:source ,(match (assoc-ref inputs "source") 107 (emacs-build #:name #$name
107 (((? derivation? source)) 108 #:source #+source
108 (derivation->output-path source)) 109 #:system #$system
109 ((source) 110 #:test-command #$test-command
110 source) 111 #:tests? #$tests?
111 (source 112 #:parallel-tests? #$parallel-tests?
112 source)) 113 #:phases #$phases
113 #:system ,system 114 #:outputs #$(outputs->gexp outputs)
114 #:test-command ,test-command 115 #:include #$include
115 #:tests? ,tests? 116 #:exclude #$exclude
116 #:parallel-tests? ,parallel-tests? 117 #:search-paths '#$(map search-path-specification->sexp
117 #:phases ,phases 118 search-paths)
118 #:outputs %outputs 119 #:inputs #$(input-tuples->gexp inputs)))))
119 #:include ,include
120 #:exclude ,exclude
121 #:search-paths ',(map search-path-specification->sexp
122 search-paths)
123 #:inputs %build-inputs)))
124 120
125 (define guile-for-build 121 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
126 (match guile 122 system #:graft? #f)))
127 ((? package?) 123 (gexp->derivation name builder
128 (package-derivation store guile system #:graft? #f)) 124 #:system system
129 (#f ; the default 125 #:guile-for-build guile)))
130 (let* ((distro (resolve-interface '(gnu packages commencement)))
131 (guile (module-ref distro 'guile-final)))
132 (package-derivation store guile system #:graft? #f)))))
133
134 (build-expression->derivation store name builder
135 #:inputs inputs
136 #:system system
137 #:modules imported-modules
138 #:outputs outputs
139 #:guile-for-build guile-for-build))
140 126
141(define emacs-build-system 127(define emacs-build-system
142 (build-system 128 (build-system
diff --git a/guix/build-system/font.scm b/guix/build-system/font.scm
index d40a4985f82..e7160ff426a 100644
--- a/guix/build-system/font.scm
+++ b/guix/build-system/font.scm
@@ -17,6 +17,9 @@
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. 17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18 18
19(define-module (guix build-system font) 19(define-module (guix build-system font)
20 #:use-module (guix gexp)
21 #:use-module (guix store)
22 #:use-module (guix monads)
20 #:use-module (guix utils) 23 #:use-module (guix utils)
21 #:use-module (guix packages) 24 #:use-module (guix packages)
22 #:use-module (guix derivations) 25 #:use-module (guix derivations)
@@ -69,7 +72,7 @@
69 (build font-build) 72 (build font-build)
70 (arguments (strip-keyword-arguments private-keywords arguments)))) 73 (arguments (strip-keyword-arguments private-keywords arguments))))
71 74
72(define* (font-build store name inputs 75(define* (font-build name inputs
73 #:key source 76 #:key source
74 (tests? #t) 77 (tests? #t)
75 (test-target "test") 78 (test-target "test")
@@ -85,41 +88,29 @@
85 (guix build utils)))) 88 (guix build utils))))
86 "Build SOURCE with INPUTS." 89 "Build SOURCE with INPUTS."
87 (define builder 90 (define builder
88 `(begin 91 (with-imported-modules imported-modules
89 (use-modules ,@modules) 92 #~(begin
90 (font-build #:name ,name 93 (use-modules #$@modules)
91 #:source ,(match (assoc-ref inputs "source")
92 (((? derivation? source))
93 (derivation->output-path source))
94 ((source)
95 source)
96 (source
97 source))
98 #:configure-flags ,configure-flags
99 #:system ,system
100 #:test-target ,test-target
101 #:tests? ,tests?
102 #:phases ,phases
103 #:outputs %outputs
104 #:search-paths ',(map search-path-specification->sexp
105 search-paths)
106 #:inputs %build-inputs)))
107 94
108 (define guile-for-build 95 #$(with-build-variables inputs outputs
109 (match guile 96 #~(font-build #:name #$name
110 ((? package?) 97 #:source #+source
111 (package-derivation store guile system #:graft? #f)) 98 #:configure-flags #$configure-flags
112 (#f ; the default 99 #:system #$system
113 (let* ((distro (resolve-interface '(gnu packages commencement))) 100 #:test-target #$test-target
114 (guile (module-ref distro 'guile-final))) 101 #:tests? #$tests?
115 (package-derivation store guile system #:graft? #f))))) 102 #:phases #$phases
103 #:outputs %outputs
104 #:search-paths '#$(map search-path-specification->sexp
105 search-paths)
106 #:inputs %build-inputs)))))
116 107
117 (build-expression->derivation store name builder 108 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
118 #:inputs inputs 109 system #:graft? #f)))
119 #:system system 110 (gexp->derivation name builder
120 #:modules imported-modules 111 #:system system
121 #:outputs outputs 112 #:target #f
122 #:guile-for-build guile-for-build)) 113 #:guile-for-build guile)))
123 114
124(define font-build-system 115(define font-build-system
125 (build-system 116 (build-system
diff --git a/guix/build-system/glib-or-gtk.scm b/guix/build-system/glib-or-gtk.scm
index fb1f8fb930d..6c09b5a3b75 100644
--- a/guix/build-system/glib-or-gtk.scm
+++ b/guix/build-system/glib-or-gtk.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013, 2014, 2015, 2019, 2020 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2013, 2014, 2015, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> 3;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
4;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch> 4;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch>
5;;; 5;;;
@@ -21,6 +21,8 @@
21(define-module (guix build-system glib-or-gtk) 21(define-module (guix build-system glib-or-gtk)
22 #:use-module (guix store) 22 #:use-module (guix store)
23 #:use-module (guix utils) 23 #:use-module (guix utils)
24 #:use-module (guix gexp)
25 #:use-module (guix monads)
24 #:use-module (guix derivations) 26 #:use-module (guix derivations)
25 #:use-module (guix search-paths) 27 #:use-module (guix search-paths)
26 #:use-module (guix build-system) 28 #:use-module (guix build-system)
@@ -85,7 +87,7 @@
85 #:rest arguments) 87 #:rest arguments)
86 "Return a bag for NAME." 88 "Return a bag for NAME."
87 (define private-keywords 89 (define private-keywords
88 '(#:source #:target #:glib #:inputs #:native-inputs 90 '(#:target #:glib #:inputs #:native-inputs
89 #:outputs #:implicit-inputs?)) 91 #:outputs #:implicit-inputs?))
90 92
91 (and (not target) ;XXX: no cross-compilation 93 (and (not target) ;XXX: no cross-compilation
@@ -105,8 +107,8 @@
105 (build glib-or-gtk-build) 107 (build glib-or-gtk-build)
106 (arguments (strip-keyword-arguments private-keywords arguments))))) 108 (arguments (strip-keyword-arguments private-keywords arguments)))))
107 109
108(define* (glib-or-gtk-build store name inputs 110(define* (glib-or-gtk-build name inputs
109 #:key (guile #f) 111 #:key guile source
110 (outputs '("out")) 112 (outputs '("out"))
111 (search-paths '()) 113 (search-paths '())
112 (configure-flags ''()) 114 (configure-flags ''())
@@ -132,70 +134,43 @@
132 allowed-references 134 allowed-references
133 disallowed-references) 135 disallowed-references)
134 "Build SOURCE with INPUTS. See GNU-BUILD for more details." 136 "Build SOURCE with INPUTS. See GNU-BUILD for more details."
135 (define canonicalize-reference 137 (define build
136 (match-lambda 138 (with-imported-modules imported-modules
137 ((? package? p) 139 #~(begin
138 (derivation->output-path (package-derivation store p system))) 140 (use-modules #$@modules)
139 (((? package? p) output)
140 (derivation->output-path (package-derivation store p system)
141 output))
142 ((? string? output)
143 output)))
144 141
145 (define builder 142 #$(with-build-variables inputs outputs
146 `(begin 143 #~(glib-or-gtk-build #:source #+source
147 (use-modules ,@modules) 144 #:system #$system
148 (glib-or-gtk-build #:source ,(match (assoc-ref inputs "source") 145 #:outputs %outputs
149 (((? derivation? source)) 146 #:inputs %build-inputs
150 (derivation->output-path source)) 147 #:search-paths '#$(map search-path-specification->sexp
151 ((source) 148 search-paths)
152 source) 149 #:phases #$phases
153 (source 150 #:glib-or-gtk-wrap-excluded-outputs
154 source)) 151 #$glib-or-gtk-wrap-excluded-outputs
155 #:system ,system 152 #:configure-flags #$configure-flags
156 #:outputs %outputs 153 #:make-flags #$make-flags
157 #:inputs %build-inputs 154 #:out-of-source? #$out-of-source?
158 #:search-paths ',(map search-path-specification->sexp 155 #:tests? #$tests?
159 search-paths) 156 #:test-target #$test-target
160 #:phases ,phases 157 #:parallel-build? #$parallel-build?
161 #:glib-or-gtk-wrap-excluded-outputs 158 #:parallel-tests? #$parallel-tests?
162 ,glib-or-gtk-wrap-excluded-outputs 159 #:validate-runpath? #$validate-runpath?
163 #:configure-flags ,configure-flags 160 #:patch-shebangs? #$patch-shebangs?
164 #:make-flags ,make-flags 161 #:strip-binaries? #$strip-binaries?
165 #:out-of-source? ,out-of-source? 162 #:strip-flags #$strip-flags
166 #:tests? ,tests? 163 #:strip-directories #$strip-directories)))))
167 #:test-target ,test-target
168 #:parallel-build? ,parallel-build?
169 #:parallel-tests? ,parallel-tests?
170 #:validate-runpath? ,validate-runpath?
171 #:patch-shebangs? ,patch-shebangs?
172 #:strip-binaries? ,strip-binaries?
173 #:strip-flags ,strip-flags
174 #:strip-directories ,strip-directories)))
175 164
176 (define guile-for-build
177 (match guile
178 ((? package?)
179 (package-derivation store guile system #:graft? #f))
180 (#f ; the default
181 (let* ((distro (resolve-interface '(gnu packages commencement)))
182 (guile (module-ref distro 'guile-final)))
183 (package-derivation store guile system #:graft? #f)))))
184 165
185 (build-expression->derivation store name builder 166 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
186 #:system system 167 system #:graft? #f)))
187 #:inputs inputs 168 (gexp->derivation name build
188 #:modules imported-modules 169 #:system system
189 #:outputs outputs 170 #:target #f
190 #:allowed-references 171 #:allowed-references allowed-references
191 (and allowed-references 172 #:disallowed-references disallowed-references
192 (map canonicalize-reference 173 #:guile-for-build guile)))
193 allowed-references))
194 #:disallowed-references
195 (and disallowed-references
196 (map canonicalize-reference
197 disallowed-references))
198 #:guile-for-build guile-for-build))
199 174
200(define glib-or-gtk-build-system 175(define glib-or-gtk-build-system
201 (build-system 176 (build-system
diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index fc045f10c92..613deb7bb01 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
3;;; 3;;;
4;;; This file is part of GNU Guix. 4;;; This file is part of GNU Guix.
5;;; 5;;;
@@ -20,6 +20,8 @@
20 #:use-module (guix store) 20 #:use-module (guix store)
21 #:use-module (guix utils) 21 #:use-module (guix utils)
22 #:use-module (guix memoization) 22 #:use-module (guix memoization)
23 #:use-module (guix gexp)
24 #:use-module (guix monads)
23 #:use-module (guix derivations) 25 #:use-module (guix derivations)
24 #:use-module (guix search-paths) 26 #:use-module (guix search-paths)
25 #:use-module (guix build-system) 27 #:use-module (guix build-system)
@@ -281,7 +283,7 @@ standard packages used as implicit inputs of the GNU build system."
281 #:rest arguments) 283 #:rest arguments)
282 "Return a bag for NAME from the given arguments." 284 "Return a bag for NAME from the given arguments."
283 (define private-keywords 285 (define private-keywords
284 `(#:source #:inputs #:native-inputs #:outputs 286 `(#:inputs #:native-inputs #:outputs
285 #:implicit-inputs? #:implicit-cross-inputs? 287 #:implicit-inputs? #:implicit-cross-inputs?
286 ,@(if target '() '(#:target)))) 288 ,@(if target '() '(#:target))))
287 289
@@ -328,8 +330,9 @@ standard packages used as implicit inputs of the GNU build system."
328 ;; Typical names of Autotools "bootstrap" scripts. 330 ;; Typical names of Autotools "bootstrap" scripts.
329 '("bootstrap" "bootstrap.sh" "autogen.sh")) 331 '("bootstrap" "bootstrap.sh" "autogen.sh"))
330 332
331(define* (gnu-build store name input-drvs 333(define* (gnu-build name inputs
332 #:key (guile #f) 334 #:key
335 guile source
333 (outputs '("out")) 336 (outputs '("out"))
334 (search-paths '()) 337 (search-paths '())
335 (bootstrap-scripts (list 'quote %bootstrap-scripts)) 338 (bootstrap-scripts (list 'quote %bootstrap-scripts))
@@ -374,80 +377,48 @@ SUBSTITUTABLE? determines whether users may be able to use substitutes of the
374returned derivations, or whether they should always build it locally. 377returned derivations, or whether they should always build it locally.
375 378
376ALLOWED-REFERENCES can be either #f, or a list of packages that the outputs 379ALLOWED-REFERENCES can be either #f, or a list of packages that the outputs
377are allowed to refer to. Likewise for DISALLOWED-REFERENCES, which lists 380are allowed to refer to."
378packages that must not be referenced."
379 (define canonicalize-reference
380 (match-lambda
381 ((? package? p)
382 (derivation->output-path (package-derivation store p system
383 #:graft? #f)))
384 (((? package? p) output)
385 (derivation->output-path (package-derivation store p system
386 #:graft? #f)
387 output))
388 ((? string? output)
389 output)))
390
391 (define builder 381 (define builder
392 `(begin 382 (with-imported-modules imported-modules
393 (use-modules ,@modules) 383 #~(begin
394 (gnu-build #:source ,(match (assoc-ref input-drvs "source") 384 (use-modules #$@modules)
395 (((? derivation? source)) 385
396 (derivation->output-path source)) 386 #$(with-build-variables inputs outputs
397 ((source) 387 #~(gnu-build #:source #+source
398 source) 388 #:system #$system
399 (source 389 #:build #$build
400 source)) 390 #:outputs %outputs
401 #:system ,system 391 #:inputs %build-inputs
402 #:build ,build 392 #:search-paths '#$(map search-path-specification->sexp
403 #:outputs %outputs 393 search-paths)
404 #:inputs %build-inputs 394 #:phases #$phases
405 #:search-paths ',(map search-path-specification->sexp 395 #:locale #$locale
406 search-paths) 396 #:bootstrap-scripts #$bootstrap-scripts
407 #:phases ,phases 397 #:configure-flags #$configure-flags
408 #:locale ,locale 398 #:make-flags #$make-flags
409 #:bootstrap-scripts ,bootstrap-scripts 399 #:out-of-source? #$out-of-source?
410 #:configure-flags ,configure-flags 400 #:tests? #$tests?
411 #:make-flags ,make-flags 401 #:test-target #$test-target
412 #:out-of-source? ,out-of-source? 402 #:parallel-build? #$parallel-build?
413 #:tests? ,tests? 403 #:parallel-tests? #$parallel-tests?
414 #:test-target ,test-target 404 #:patch-shebangs? #$patch-shebangs?
415 #:parallel-build? ,parallel-build? 405 #:license-file-regexp #$license-file-regexp
416 #:parallel-tests? ,parallel-tests? 406 #:strip-binaries? #$strip-binaries?
417 #:patch-shebangs? ,patch-shebangs? 407 #:validate-runpath? #$validate-runpath?
418 #:strip-binaries? ,strip-binaries? 408 #:make-dynamic-linker-cache? #$make-dynamic-linker-cache?
419 #:validate-runpath? ,validate-runpath? 409 #:license-file-regexp #$license-file-regexp
420 #:make-dynamic-linker-cache? ,make-dynamic-linker-cache? 410 #:strip-flags #$strip-flags
421 #:license-file-regexp ,license-file-regexp 411 #:strip-directories #$strip-directories)))))
422 #:strip-flags ,strip-flags 412
423 #:strip-directories ,strip-directories))) 413 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
424 414 system #:graft? #f)))
425 (define guile-for-build 415 (gexp->derivation name builder
426 (match guile 416 #:system system
427 ((? package?) 417 #:target #f
428 (package-derivation store guile system #:graft? #f)) 418 #:substitutable? substitutable?
429 (#f ; the default 419 #:allowed-references allowed-references
430 (let* ((distro (resolve-interface '(gnu packages commencement))) 420 #:disallowed-references disallowed-references
431 (guile (module-ref distro 'guile-final))) 421 #:guile-for-build guile)))
432 (package-derivation store guile system
433 #:graft? #f)))))
434
435 (build-expression->derivation store name builder
436 #:system system
437 #:inputs input-drvs
438 #:outputs outputs
439 #:modules imported-modules
440 #:substitutable? substitutable?
441
442 #:allowed-references
443 (and allowed-references
444 (map canonicalize-reference
445 allowed-references))
446 #:disallowed-references
447 (and disallowed-references
448 (map canonicalize-reference
449 disallowed-references))
450 #:guile-for-build guile-for-build))
451 422
452 423
453;;; 424;;;
@@ -483,11 +454,11 @@ is one of `host' or `target'."
483 `(("cross-libc:static" ,libc "static")) 454 `(("cross-libc:static" ,libc "static"))
484 '())))))))) 455 '()))))))))
485 456
486(define* (gnu-cross-build store name 457(define* (gnu-cross-build name
487 #:key 458 #:key
488 target native-drvs target-drvs 459 target
489 (guile #f) 460 build-inputs target-inputs host-inputs
490 source 461 guile source
491 (outputs '("out")) 462 (outputs '("out"))
492 (search-paths '()) 463 (search-paths '())
493 (native-search-paths '()) 464 (native-search-paths '())
@@ -525,104 +496,67 @@ is one of `host' or `target'."
525 "Cross-build NAME for TARGET, where TARGET is a GNU triplet. INPUTS are 496 "Cross-build NAME for TARGET, where TARGET is a GNU triplet. INPUTS are
526cross-built inputs, and NATIVE-INPUTS are inputs that run on the build 497cross-built inputs, and NATIVE-INPUTS are inputs that run on the build
527platform." 498platform."
528 (define canonicalize-reference
529 (match-lambda
530 ((? package? p)
531 (derivation->output-path (package-cross-derivation store p
532 target system)))
533 (((? package? p) output)
534 (derivation->output-path (package-cross-derivation store p
535 target system)
536 output))
537 ((? string? output)
538 output)))
539
540 (define builder 499 (define builder
541 `(begin 500 #~(begin
542 (use-modules ,@modules) 501 (use-modules #$@modules)
543 502
544 (let () 503 (define %build-host-inputs
545 (define %build-host-inputs 504 (map (lambda (tuple)
546 ',(map (match-lambda 505 (apply cons tuple))
547 ((name (? derivation? drv) sub ...) 506 '#+build-inputs))
548 `(,name . ,(apply derivation->output-path drv sub))) 507
549 ((name path) 508 (define %build-target-inputs
550 `(,name . ,path))) 509 (map (lambda (tuple)
551 native-drvs)) 510 (apply cons tuple))
552 511 (append '#$host-inputs '#+target-inputs)))
553 (define %build-target-inputs 512
554 ',(map (match-lambda 513 (define %outputs
555 ((name (? derivation? drv) sub ...) 514 (list #$@(map (lambda (name)
556 `(,name . ,(apply derivation->output-path drv sub))) 515 #~(cons #$name
557 ((name (? package? pkg) sub ...) 516 (ungexp output name)))
558 (let ((drv (package-cross-derivation store pkg 517 outputs)))
559 target system))) 518
560 `(,name . ,(apply derivation->output-path drv sub)))) 519 (gnu-build #:source #+source
561 ((name path) 520 #:system #$system
562 `(,name . ,path))) 521 #:build #$build
563 target-drvs)) 522 #:target #$target
564 523 #:outputs %outputs
565 (gnu-build #:source ,(match (assoc-ref native-drvs "source") 524 #:inputs %build-target-inputs
566 (((? derivation? source)) 525 #:native-inputs %build-host-inputs
567 (derivation->output-path source)) 526 #:search-paths '#$(map search-path-specification->sexp
568 ((source)
569 source)
570 (source
571 source))
572 #:system ,system
573 #:build ,build
574 #:target ,target
575 #:outputs %outputs
576 #:inputs %build-target-inputs
577 #:native-inputs %build-host-inputs
578 #:search-paths ',(map search-path-specification->sexp
579 search-paths) 527 search-paths)
580 #:native-search-paths ',(map 528 #:native-search-paths '#$(map
581 search-path-specification->sexp 529 search-path-specification->sexp
582 native-search-paths) 530 native-search-paths)
583 #:phases ,phases 531 #:phases #$phases
584 #:locale ,locale 532 #:locale #$locale
585 #:bootstrap-scripts ,bootstrap-scripts 533 #:bootstrap-scripts #$bootstrap-scripts
586 #:configure-flags ,configure-flags 534 #:configure-flags #$configure-flags
587 #:make-flags ,make-flags 535 #:make-flags #$make-flags
588 #:out-of-source? ,out-of-source? 536 #:out-of-source? #$out-of-source?
589 #:tests? ,tests? 537 #:tests? #$tests?
590 #:test-target ,test-target 538 #:test-target #$test-target
591 #:parallel-build? ,parallel-build? 539 #:parallel-build? #$parallel-build?
592 #:parallel-tests? ,parallel-tests? 540 #:parallel-tests? #$parallel-tests?
593 #:patch-shebangs? ,patch-shebangs? 541 #:patch-shebangs? #$patch-shebangs?
594 #:strip-binaries? ,strip-binaries? 542 #:license-file-regexp #$license-file-regexp
595 #:validate-runpath? ,validate-runpath? 543 #:strip-binaries? #$strip-binaries?
596 #:make-dynamic-linker-cache? ,make-dynamic-linker-cache? 544 #:validate-runpath? #$validate-runpath?
597 #:license-file-regexp ,license-file-regexp 545 #:make-dynamic-linker-cache? #$make-dynamic-linker-cache?
598 #:strip-flags ,strip-flags 546 #:license-file-regexp #$license-file-regexp
599 #:strip-directories ,strip-directories)))) 547 #:strip-flags #$strip-flags
600 548 #:strip-directories #$strip-directories)))
601 (define guile-for-build 549
602 (match guile 550 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
603 ((? package?) 551 system #:graft? #f)))
604 (package-derivation store guile system #:graft? #f)) 552 (gexp->derivation name builder
605 (#f ; the default 553 #:system system
606 (let* ((distro (resolve-interface '(gnu packages commencement))) 554 #:target target
607 (guile (module-ref distro 'guile-final))) 555 #:modules imported-modules
608 (package-derivation store guile system #:graft? #f))))) 556 #:substitutable? substitutable?
609 557 #:allowed-references allowed-references
610 (build-expression->derivation store name builder 558 #:disallowed-references disallowed-references
611 #:system system 559 #:guile-for-build guile)))
612 #:inputs (append native-drvs target-drvs)
613 #:outputs outputs
614 #:modules imported-modules
615 #:substitutable? substitutable?
616
617 #:allowed-references
618 (and allowed-references
619 (map canonicalize-reference
620 allowed-references))
621 #:disallowed-references
622 (and disallowed-references
623 (map canonicalize-reference
624 disallowed-references))
625 #:guile-for-build guile-for-build))
626 560
627(define gnu-build-system 561(define gnu-build-system
628 (build-system 562 (build-system
diff --git a/guix/build-system/go.scm b/guix/build-system/go.scm
index 0e2c1cd2ee2..4c8156e73cd 100644
--- a/guix/build-system/go.scm
+++ b/guix/build-system/go.scm
@@ -2,6 +2,7 @@
2;;; Copyright © 2016 Petter <petter@mykolab.ch> 2;;; Copyright © 2016 Petter <petter@mykolab.ch>
3;;; Copyright © 2017 Leo Famulari <leo@famulari.name> 3;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
4;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> 4;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
5;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
5;;; 6;;;
6;;; This file is part of GNU Guix. 7;;; This file is part of GNU Guix.
7;;; 8;;;
@@ -20,7 +21,9 @@
20 21
21(define-module (guix build-system go) 22(define-module (guix build-system go)
22 #:use-module (guix utils) 23 #:use-module (guix utils)
23 #:use-module (guix derivations) 24 #:use-module (guix gexp)
25 #:use-module (guix store)
26 #:use-module (guix monads)
24 #:use-module (guix search-paths) 27 #:use-module (guix search-paths)
25 #:use-module (guix build-system) 28 #:use-module (guix build-system)
26 #:use-module (guix build-system gnu) 29 #:use-module (guix build-system gnu)
@@ -88,7 +91,7 @@ it, defaulting to full VERSION if a pseudo-version pattern is not recognized."
88 #:rest arguments) 91 #:rest arguments)
89 "Return a bag for NAME." 92 "Return a bag for NAME."
90 (define private-keywords 93 (define private-keywords
91 '(#:source #:target #:go #:inputs #:native-inputs)) 94 '(#:target #:go #:inputs #:native-inputs))
92 95
93 (and (not target) ;XXX: no cross-compilation 96 (and (not target) ;XXX: no cross-compilation
94 (bag 97 (bag
@@ -107,8 +110,9 @@ it, defaulting to full VERSION if a pseudo-version pattern is not recognized."
107 (build go-build) 110 (build go-build)
108 (arguments (strip-keyword-arguments private-keywords arguments))))) 111 (arguments (strip-keyword-arguments private-keywords arguments)))))
109 112
110(define* (go-build store name inputs 113(define* (go-build name inputs
111 #:key 114 #:key
115 source
112 (phases '(@ (guix build go-build-system) 116 (phases '(@ (guix build go-build-system)
113 %standard-phases)) 117 %standard-phases))
114 (outputs '("out")) 118 (outputs '("out"))
@@ -126,45 +130,29 @@ it, defaulting to full VERSION if a pseudo-version pattern is not recognized."
126 (guix build union) 130 (guix build union)
127 (guix build utils)))) 131 (guix build utils))))
128 (define builder 132 (define builder
129 `(begin 133 (with-imported-modules imported-modules
130 (use-modules ,@modules) 134 #~(begin
131 (go-build #:name ,name 135 (use-modules #$@modules)
132 #:source ,(match (assoc-ref inputs "source") 136 (go-build #:name #$name
133 (((? derivation? source)) 137 #:source #+source
134 (derivation->output-path source)) 138 #:system #$system
135 ((source) 139 #:phases #$phases
136 source) 140 #:outputs #$(outputs->gexp outputs)
137 (source 141 #:search-paths '#$(map search-path-specification->sexp
138 source)) 142 search-paths)
139 #:system ,system 143 #:install-source? #$install-source?
140 #:phases ,phases 144 #:import-path #$import-path
141 #:outputs %outputs 145 #:unpack-path #$unpack-path
142 #:search-paths ',(map search-path-specification->sexp 146 #:build-flags #$build-flags
143 search-paths) 147 #:tests? #$tests?
144 #:install-source? ,install-source? 148 #:allow-go-reference? #$allow-go-reference?
145 #:import-path ,import-path 149 #:inputs #$(input-tuples->gexp inputs)))))
146 #:unpack-path ,unpack-path
147 #:build-flags ,build-flags
148 #:tests? ,tests?
149 #:allow-go-reference? ,allow-go-reference?
150 #:inputs %build-inputs)))
151 150
152 (define guile-for-build 151 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
153 (match guile 152 system #:graft? #f)))
154 ((? package?) 153 (gexp->derivation name builder
155 (package-derivation store guile system #:graft? #f)) 154 #:system system
156 (#f ; the default 155 #:guile-for-build guile)))
157 (let* ((distro (resolve-interface '(gnu packages commencement)))
158 (guile (module-ref distro 'guile-final)))
159 (package-derivation store guile system
160 #:graft? #f)))))
161
162 (build-expression->derivation store name builder
163 #:inputs inputs
164 #:system system
165 #:modules imported-modules
166 #:outputs outputs
167 #:guile-for-build guile-for-build))
168 156
169(define go-build-system 157(define go-build-system
170 (build-system 158 (build-system
diff --git a/guix/build-system/guile.scm b/guix/build-system/guile.scm
index 45e735b9874..f64f2146755 100644
--- a/guix/build-system/guile.scm
+++ b/guix/build-system/guile.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
3;;; 3;;;
4;;; This file is part of GNU Guix. 4;;; This file is part of GNU Guix.
5;;; 5;;;
@@ -20,7 +20,8 @@
20 #:use-module (guix store) 20 #:use-module (guix store)
21 #:use-module (guix utils) 21 #:use-module (guix utils)
22 #:use-module (guix packages) 22 #:use-module (guix packages)
23 #:use-module (guix derivations) 23 #:use-module (guix monads)
24 #:use-module (guix gexp)
24 #:use-module (guix search-paths) 25 #:use-module (guix search-paths)
25 #:use-module (guix build-system) 26 #:use-module (guix build-system)
26 #:use-module (guix build-system gnu) 27 #:use-module (guix build-system gnu)
@@ -75,7 +76,7 @@
75 ;; denominator between Guile 2.0 and 2.2. 76 ;; denominator between Guile 2.0 and 2.2.
76 ''("-Wunbound-variable" "-Warity-mismatch" "-Wformat")) 77 ''("-Wunbound-variable" "-Warity-mismatch" "-Wformat"))
77 78
78(define* (guile-build store name inputs 79(define* (guile-build name inputs
79 #:key source 80 #:key source
80 (guile #f) 81 (guile #f)
81 (phases '%standard-phases) 82 (phases '%standard-phases)
@@ -91,47 +92,34 @@
91 (guix build utils)))) 92 (guix build utils))))
92 "Build SOURCE using Guile taken from the native inputs, and with INPUTS." 93 "Build SOURCE using Guile taken from the native inputs, and with INPUTS."
93 (define builder 94 (define builder
94 `(begin 95 (with-imported-modules imported-modules
95 (use-modules ,@modules) 96 #~(begin
96 (guile-build #:name ,name 97 (use-modules #$@modules)
97 #:source ,(match (assoc-ref inputs "source") 98
98 (((? derivation? source)) 99 (guile-build #:name #$name
99 (derivation->output-path source)) 100 #:source #+source
100 ((source) 101 #:source-directory #$source-directory
101 source) 102 #:scheme-file-regexp #$scheme-file-regexp
102 (source 103 #:not-compiled-file-regexp #$not-compiled-file-regexp
103 source)) 104 #:compile-flags #$compile-flags
104 #:source-directory ,source-directory 105 #:phases #$phases
105 #:scheme-file-regexp ,scheme-file-regexp 106 #:system #$system
106 #:not-compiled-file-regexp ,not-compiled-file-regexp 107 #:outputs #$(outputs->gexp outputs)
107 #:compile-flags ,compile-flags 108 #:inputs #$(input-tuples->gexp inputs)
108 #:phases ,phases 109 #:search-paths '#$(map search-path-specification->sexp
109 #:system ,system 110 search-paths)))))
110 #:outputs %outputs 111
111 #:search-paths ',(map search-path-specification->sexp 112 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
112 search-paths) 113 system #:graft? #f)))
113 #:inputs %build-inputs))) 114 (gexp->derivation name builder
114 115 #:system system
115 (define guile-for-build 116 #:target #f
116 (match guile 117 #:guile-for-build guile)))
117 ((? package?) 118
118 (package-derivation store guile system #:graft? #f)) 119(define* (guile-cross-build name
119 (#f ; the default
120 (let* ((distro (resolve-interface '(gnu packages commencement)))
121 (guile (module-ref distro 'guile-final)))
122 (package-derivation store guile system #:graft? #f)))))
123
124 (build-expression->derivation store name builder
125 #:inputs inputs
126 #:system system
127 #:modules imported-modules
128 #:outputs outputs
129 #:guile-for-build guile-for-build))
130
131(define* (guile-cross-build store name
132 #:key 120 #:key
133 (system (%current-system)) target 121 (system (%current-system)) target
134 native-drvs target-drvs 122 build-inputs target-inputs host-inputs
135 (guile #f) 123 (guile #f)
136 source 124 source
137 (outputs '("out")) 125 (outputs '("out"))
@@ -146,68 +134,42 @@
146 (modules '((guix build guile-build-system) 134 (modules '((guix build guile-build-system)
147 (guix build utils)))) 135 (guix build utils))))
148 (define builder 136 (define builder
149 `(begin 137 (with-imported-modules imported-modules
150 (use-modules ,@modules) 138 #~(begin
151 139 (use-modules #$@modules)
152 (let () 140
153 (define %build-host-inputs 141 (define %build-host-inputs
154 ',(map (match-lambda 142 #+(input-tuples->gexp build-inputs))
155 ((name (? derivation? drv) sub ...) 143
156 `(,name . ,(apply derivation->output-path drv sub))) 144 (define %build-target-inputs
157 ((name path) 145 (append #$(input-tuples->gexp host-inputs)
158 `(,name . ,path))) 146 #+(input-tuples->gexp target-inputs)))
159 native-drvs)) 147
160 148 (define %outputs
161 (define %build-target-inputs 149 #$(outputs->gexp outputs))
162 ',(map (match-lambda 150
163 ((name (? derivation? drv) sub ...) 151 (guile-build #:source #+source
164 `(,name . ,(apply derivation->output-path drv sub))) 152 #:system #$system
165 ((name (? package? pkg) sub ...) 153 #:target #$target
166 (let ((drv (package-cross-derivation store pkg 154 #:outputs %outputs
167 target system))) 155 #:source-directory #$source-directory
168 `(,name . ,(apply derivation->output-path drv sub)))) 156 #:not-compiled-file-regexp #$not-compiled-file-regexp
169 ((name path) 157 #:compile-flags #$compile-flags
170 `(,name . ,path))) 158 #:inputs %build-target-inputs
171 target-drvs)) 159 #:native-inputs %build-host-inputs
172 160 #:search-paths '#$(map search-path-specification->sexp
173 (guile-build #:source ,(match (assoc-ref native-drvs "source") 161 search-paths)
174 (((? derivation? source)) 162 #:native-search-paths '#$(map
175 (derivation->output-path source)) 163 search-path-specification->sexp
176 ((source) 164 native-search-paths)
177 source) 165 #:phases #$phases))))
178 (source 166
179 source)) 167 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
180 #:system ,system 168 system #:graft? #f)))
181 #:target ,target 169 (gexp->derivation name builder
182 #:outputs %outputs 170 #:system system
183 #:source-directory ,source-directory 171 #:target target
184 #:not-compiled-file-regexp ,not-compiled-file-regexp 172 #:guile-for-build guile)))
185 #:compile-flags ,compile-flags
186 #:inputs %build-target-inputs
187 #:native-inputs %build-host-inputs
188 #:search-paths ',(map search-path-specification->sexp
189 search-paths)
190 #:native-search-paths ',(map
191 search-path-specification->sexp
192 native-search-paths)
193 #:phases ,phases))))
194
195 (define guile-for-build
196 (match guile
197 ((? package?)
198 (package-derivation store guile system #:graft? #f))
199 (#f ; the default
200 (let* ((distro (resolve-interface '(gnu packages commencement)))
201 (guile (module-ref distro 'guile-final)))
202 (package-derivation store guile system #:graft? #f)))))
203
204 (build-expression->derivation store name builder
205 #:system system
206 #:inputs (append native-drvs target-drvs)
207 #:outputs outputs
208 #:modules imported-modules
209 #:substitutable? substitutable?
210 #:guile-for-build guile-for-build))
211 173
212(define guile-build-system 174(define guile-build-system
213 (build-system 175 (build-system
diff --git a/guix/build-system/haskell.scm b/guix/build-system/haskell.scm
index 18a584f7825..b7ee72557cb 100644
--- a/guix/build-system/haskell.scm
+++ b/guix/build-system/haskell.scm
@@ -2,6 +2,7 @@
2;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> 2;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
3;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com> 3;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
4;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com> 4;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
5;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
5;;; 6;;;
6;;; This file is part of GNU Guix. 7;;; This file is part of GNU Guix.
7;;; 8;;;
@@ -22,7 +23,8 @@
22 #:use-module (guix store) 23 #:use-module (guix store)
23 #:use-module (guix utils) 24 #:use-module (guix utils)
24 #:use-module (guix packages) 25 #:use-module (guix packages)
25 #:use-module (guix derivations) 26 #:use-module (guix gexp)
27 #:use-module (guix monads)
26 #:use-module (guix download) 28 #:use-module (guix download)
27 #:use-module (guix search-paths) 29 #:use-module (guix search-paths)
28 #:use-module (guix build-system) 30 #:use-module (guix build-system)
@@ -116,7 +118,7 @@ version REVISION."
116 (cons name propagated-names)))))) 118 (cons name propagated-names))))))
117 extra-directories)))))))) 119 extra-directories))))))))
118 120
119(define* (haskell-build store name inputs 121(define* (haskell-build name inputs
120 #:key source 122 #:key source
121 (haddock? #t) 123 (haddock? #t)
122 (haddock-flags ''()) 124 (haddock-flags ''())
@@ -139,50 +141,33 @@ version REVISION."
139 "Build SOURCE using HASKELL, and with INPUTS. This assumes that SOURCE 141 "Build SOURCE using HASKELL, and with INPUTS. This assumes that SOURCE
140provides a 'Setup.hs' file as its build system." 142provides a 'Setup.hs' file as its build system."
141 (define builder 143 (define builder
142 `(begin 144 (with-imported-modules imported-modules
143 (use-modules ,@modules) 145 #~(begin
144 (haskell-build #:name ,name 146 (use-modules #$@modules)
145 #:source ,(match (assoc-ref inputs "source")
146 (((? derivation? source))
147 (derivation->output-path source))
148 ((source)
149 source)
150 (source
151 source))
152 #:cabal-revision ,(match (assoc-ref inputs
153 "cabal-revision")
154 (((? derivation? revision))
155 (derivation->output-path revision))
156 (revision revision))
157 #:configure-flags ,configure-flags
158 #:extra-directories ,extra-directories
159 #:haddock-flags ,haddock-flags
160 #:system ,system
161 #:test-target ,test-target
162 #:tests? ,tests?
163 #:parallel-build? ,parallel-build?
164 #:haddock? ,haddock?
165 #:phases ,phases
166 #:outputs %outputs
167 #:search-paths ',(map search-path-specification->sexp
168 search-paths)
169 #:inputs %build-inputs)))
170 147
171 (define guile-for-build 148 (haskell-build #:name #$name
172 (match guile 149 #:source #+source
173 ((? package?) 150 #:cabal-revision #$(assoc-ref inputs
174 (package-derivation store guile system #:graft? #f)) 151 "cabal-revision")
175 (#f ; the default 152 #:configure-flags #$configure-flags
176 (let* ((distro (resolve-interface '(gnu packages commencement))) 153 #:extra-directories #$extra-directories
177 (guile (module-ref distro 'guile-final))) 154 #:haddock-flags #$haddock-flags
178 (package-derivation store guile system #:graft? #f))))) 155 #:system #$system
156 #:test-target #$test-target
157 #:tests? #$tests?
158 #:parallel-build? #$parallel-build?
159 #:haddock? #$haddock?
160 #:phases #$phases
161 #:outputs #$(outputs->gexp outputs)
162 #:search-paths '#$(map search-path-specification->sexp
163 search-paths)
164 #:inputs #$(input-tuples->gexp inputs)))))
179 165
180 (build-expression->derivation store name builder 166 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
181 #:inputs inputs 167 system #:graft? #f)))
182 #:system system 168 (gexp->derivation name builder
183 #:modules imported-modules 169 #:system system
184 #:outputs outputs 170 #:guile-for-build guile)))
185 #:guile-for-build guile-for-build))
186 171
187(define haskell-build-system 172(define haskell-build-system
188 (build-system 173 (build-system
diff --git a/guix/build-system/julia.scm b/guix/build-system/julia.scm
index 63cb7cd8644..6e006af527f 100644
--- a/guix/build-system/julia.scm
+++ b/guix/build-system/julia.scm
@@ -1,5 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2019 Nicolò Balzarotti <nicolo@nixo.xyz> 2;;; Copyright © 2019 Nicolò Balzarotti <nicolo@nixo.xyz>
3;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
3;;; 4;;;
4;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
5;;; 6;;;
@@ -20,7 +21,8 @@
20 #:use-module (guix store) 21 #:use-module (guix store)
21 #:use-module (guix utils) 22 #:use-module (guix utils)
22 #:use-module (guix packages) 23 #:use-module (guix packages)
23 #:use-module (guix derivations) 24 #:use-module (guix gexp)
25 #:use-module (guix monads)
24 #:use-module (guix search-paths) 26 #:use-module (guix search-paths)
25 #:use-module (guix build-system) 27 #:use-module (guix build-system)
26 #:use-module (guix build-system gnu) 28 #:use-module (guix build-system gnu)
@@ -73,7 +75,7 @@
73 (build julia-build) 75 (build julia-build)
74 (arguments (strip-keyword-arguments private-keywords arguments))))) 76 (arguments (strip-keyword-arguments private-keywords arguments)))))
75 77
76(define* (julia-build store name inputs 78(define* (julia-build name inputs
77 #:key source 79 #:key source
78 (tests? #t) 80 (tests? #t)
79 (phases '(@ (guix build julia-build-system) 81 (phases '(@ (guix build julia-build-system)
@@ -88,40 +90,25 @@
88 (guix build utils)))) 90 (guix build utils))))
89 "Build SOURCE using Julia, and with INPUTS." 91 "Build SOURCE using Julia, and with INPUTS."
90 (define builder 92 (define builder
91 `(begin 93 (with-imported-modules imported-modules
92 (use-modules ,@modules) 94 #~(begin
93 (julia-build #:name ,name 95 (use-modules #$@modules)
94 #:source ,(match (assoc-ref inputs "source") 96 (julia-build #:name #$name
95 (((? derivation? source)) 97 #:source #+source
96 (derivation->output-path source)) 98 #:system #$system
97 ((source) 99 #:tests? #$tests?
98 source) 100 #:phases #$phases
99 (source 101 #:outputs #$(outputs->gexp outputs)
100 source)) 102 #:search-paths '#$(map search-path-specification->sexp
101 #:system ,system 103 search-paths)
102 #:tests? ,tests? 104 #:inputs #$(input-tuples->gexp inputs)
103 #:phases ,phases 105 #:julia-package-name #$julia-package-name))))
104 #:outputs %outputs
105 #:search-paths ',(map search-path-specification->sexp
106 search-paths)
107 #:inputs %build-inputs
108 #:julia-package-name ,julia-package-name)))
109 106
110 (define guile-for-build 107 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
111 (match guile 108 system #:graft? #f)))
112 ((? package?) 109 (gexp->derivation name builder
113 (package-derivation store guile system #:graft? #f)) 110 #:system system
114 (#f ; the default 111 #:guile-for-build guile)))
115 (let* ((distro (resolve-interface '(gnu packages commencement)))
116 (guile (module-ref distro 'guile-final)))
117 (package-derivation store guile system #:graft? #f)))))
118
119 (build-expression->derivation store name builder
120 #:inputs inputs
121 #:system system
122 #:modules imported-modules
123 #:outputs outputs
124 #:guile-for-build guile-for-build))
125 112
126(define julia-build-system 113(define julia-build-system
127 (build-system 114 (build-system
diff --git a/guix/build-system/linux-module.scm b/guix/build-system/linux-module.scm
index fc3d959ce78..3a29a93bd7b 100644
--- a/guix/build-system/linux-module.scm
+++ b/guix/build-system/linux-module.scm
@@ -1,6 +1,7 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org> 2;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
3;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com> 3;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
4;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
4;;; 5;;;
5;;; This file is part of GNU Guix. 6;;; This file is part of GNU Guix.
6;;; 7;;;
@@ -20,7 +21,8 @@
20(define-module (guix build-system linux-module) 21(define-module (guix build-system linux-module)
21 #:use-module (guix store) 22 #:use-module (guix store)
22 #:use-module (guix utils) 23 #:use-module (guix utils)
23 #:use-module (guix derivations) 24 #:use-module (guix gexp)
25 #:use-module (guix monads)
24 #:use-module (guix search-paths) 26 #:use-module (guix search-paths)
25 #:use-module (guix build-system) 27 #:use-module (guix build-system)
26 #:use-module (guix build-system gnu) 28 #:use-module (guix build-system gnu)
@@ -114,7 +116,7 @@
114 #:rest arguments) 116 #:rest arguments)
115 "Return a bag for NAME." 117 "Return a bag for NAME."
116 (define private-keywords 118 (define private-keywords
117 `(#:source #:target #:gcc #:kmod #:linux #:inputs #:native-inputs 119 `(#:target #:gcc #:kmod #:linux #:inputs #:native-inputs
118 ,@(if target '() '(#:target)))) 120 ,@(if target '() '(#:target))))
119 121
120 (bag 122 (bag
@@ -148,9 +150,9 @@
148 (build (if target linux-module-build-cross linux-module-build)) 150 (build (if target linux-module-build-cross linux-module-build))
149 (arguments (strip-keyword-arguments private-keywords arguments)))) 151 (arguments (strip-keyword-arguments private-keywords arguments))))
150 152
151(define* (linux-module-build store name inputs 153(define* (linux-module-build name inputs
152 #:key 154 #:key
153 target 155 source target
154 (search-paths '()) 156 (search-paths '())
155 (tests? #t) 157 (tests? #t)
156 (phases '(@ (guix build linux-module-build-system) 158 (phases '(@ (guix build linux-module-build-system)
@@ -166,48 +168,34 @@
166 (guix build utils)))) 168 (guix build utils))))
167 "Build SOURCE using LINUX, and with INPUTS." 169 "Build SOURCE using LINUX, and with INPUTS."
168 (define builder 170 (define builder
169 `(begin 171 (with-imported-modules imported-modules
170 (use-modules ,@modules) 172 #~(begin
171 (linux-module-build #:name ,name 173 (use-modules #$@modules)
172 #:source ,(match (assoc-ref inputs "source") 174 (linux-module-build #:name #$name
173 (((? derivation? source)) 175 #:source #+source
174 (derivation->output-path source)) 176 #:search-paths '#$(map search-path-specification->sexp
175 ((source) 177 search-paths)
176 source) 178 #:phases #$phases
177 (source 179 #:system #$system
178 source)) 180 #:target #$target
179 #:search-paths ',(map search-path-specification->sexp 181 #:arch #$(system->arch (or target system))
180 search-paths) 182 #:tests? #$tests?
181 #:phases ,phases 183 #:outputs #$(outputs->gexp outputs)
182 #:system ,system 184 #:make-flags #$make-flags
183 #:target ,target 185 #:inputs #$(input-tuples->gexp inputs)))))
184 #:arch ,(system->arch (or target system))
185 #:tests? ,tests?
186 #:outputs %outputs
187 #:make-flags ,make-flags
188 #:inputs %build-inputs)))
189 186
190 (define guile-for-build 187 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
191 (match guile 188 system #:graft? #f)))
192 ((? package?) 189 (gexp->derivation name builder
193 (package-derivation store guile system #:graft? #f)) 190 #:system system
194 (#f ; the default 191 #:guile-for-build guile
195 (let* ((distro (resolve-interface '(gnu packages commencement))) 192 #:substitutable? substitutable?)))
196 (guile (module-ref distro 'guile-final)))
197 (package-derivation store guile system #:graft? #f)))))
198
199 (build-expression->derivation store name builder
200 #:system system
201 #:inputs inputs
202 #:modules imported-modules
203 #:outputs outputs
204 #:guile-for-build guile-for-build
205 #:substitutable? substitutable?))
206 193
207(define* (linux-module-build-cross 194(define* (linux-module-build-cross
208 store name 195 name
209 #:key 196 #:key
210 target native-drvs target-drvs 197 source target
198 build-inputs target-inputs host-inputs
211 (guile #f) 199 (guile #f)
212 (outputs '("out")) 200 (outputs '("out"))
213 (make-flags ''()) 201 (make-flags ''())
@@ -223,70 +211,42 @@
223 (modules '((guix build linux-module-build-system) 211 (modules '((guix build linux-module-build-system)
224 (guix build utils)))) 212 (guix build utils))))
225 (define builder 213 (define builder
226 `(begin 214 (with-imported-modules imported-modules
227 (use-modules ,@modules) 215 #~(begin
228 (let () 216 (use-modules #$@modules)
229 (define %build-host-inputs
230 ',(map (match-lambda
231 ((name (? derivation? drv) sub ...)
232 `(,name . ,(apply derivation->output-path drv sub)))
233 ((name path)
234 `(,name . ,path)))
235 native-drvs))
236 217
237 (define %build-target-inputs 218 (define %build-host-inputs
238 ',(map (match-lambda 219 '#+(input-tuples->gexp build-inputs))
239 ((name (? derivation? drv) sub ...)
240 `(,name . ,(apply derivation->output-path drv sub)))
241 ((name (? package? pkg) sub ...)
242 (let ((drv (package-cross-derivation store pkg
243 target system)))
244 `(,name . ,(apply derivation->output-path drv sub))))
245 ((name path)
246 `(,name . ,path)))
247 target-drvs))
248 220
249 (linux-module-build #:name ,name 221 (define %build-target-inputs
250 #:source ,(match (assoc-ref native-drvs "source") 222 (append #$(input-tuples->gexp host-inputs)
251 (((? derivation? source)) 223 #+(input-tuples->gexp target-inputs)))
252 (derivation->output-path source))
253 ((source)
254 source)
255 (source
256 source))
257 #:system ,system
258 #:target ,target
259 #:arch ,(system->arch (or target system))
260 #:outputs %outputs
261 #:make-flags ,make-flags
262 #:inputs %build-target-inputs
263 #:native-inputs %build-host-inputs
264 #:search-paths
265 ',(map search-path-specification->sexp
266 search-paths)
267 #:native-search-paths
268 ',(map
269 search-path-specification->sexp
270 native-search-paths)
271 #:phases ,phases
272 #:tests? ,tests?))))
273 224
274 (define guile-for-build 225 (linux-module-build #:name #$name
275 (match guile 226 #:source #+source
276 ((? package?) 227 #:system #$system
277 (package-derivation store guile system #:graft? #f)) 228 #:target #$target
278 (#f ; the default 229 #:arch #$(system->arch (or target system))
279 (let* ((distro (resolve-interface '(gnu packages commencement))) 230 #:outputs #$(outputs->gexp outputs)
280 (guile (module-ref distro 'guile-final))) 231 #:make-flags #$make-flags
281 (package-derivation store guile system #:graft? #f))))) 232 #:inputs %build-target-inputs
233 #:native-inputs %build-host-inputs
234 #:search-paths
235 '#$(map search-path-specification->sexp
236 search-paths)
237 #:native-search-paths
238 '#$(map
239 search-path-specification->sexp
240 native-search-paths)
241 #:phases #$phases
242 #:tests? #$tests?))))
282 243
283 (build-expression->derivation store name builder 244 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
284 #:system system 245 system #:graft? #f)))
285 #:inputs (append native-drvs target-drvs) 246 (gexp->derivation name builder
286 #:outputs outputs 247 #:system system
287 #:modules imported-modules 248 #:guile-for-build guile
288 #:guile-for-build guile-for-build 249 #:substitutable? substitutable?)))
289 #:substitutable? substitutable?))
290 250
291(define linux-module-build-system 251(define linux-module-build-system
292 (build-system 252 (build-system
diff --git a/guix/build-system/maven.scm b/guix/build-system/maven.scm
index 2dceefccc13..04358e62405 100644
--- a/guix/build-system/maven.scm
+++ b/guix/build-system/maven.scm
@@ -1,5 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu> 2;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
3;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
3;;; 4;;;
4;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
5;;; 6;;;
@@ -19,7 +20,8 @@
19(define-module (guix build-system maven) 20(define-module (guix build-system maven)
20 #:use-module (guix store) 21 #:use-module (guix store)
21 #:use-module (guix utils) 22 #:use-module (guix utils)
22 #:use-module (guix derivations) 23 #:use-module (guix gexp)
24 #:use-module (guix monads)
23 #:use-module (guix search-paths) 25 #:use-module (guix search-paths)
24 #:use-module (guix build-system) 26 #:use-module (guix build-system)
25 #:use-module (guix build-system gnu) 27 #:use-module (guix build-system gnu)
@@ -119,7 +121,7 @@
119 #:rest arguments) 121 #:rest arguments)
120 "Return a bag for NAME." 122 "Return a bag for NAME."
121 (define private-keywords 123 (define private-keywords
122 '(#:source #:target #:jdk #:maven #:maven-plugins #:inputs #:native-inputs)) 124 '(#:target #:jdk #:maven #:maven-plugins #:inputs #:native-inputs))
123 125
124 (and (not target) ;XXX: no cross-compilation 126 (and (not target) ;XXX: no cross-compilation
125 (bag 127 (bag
@@ -140,70 +142,56 @@
140 (build maven-build) 142 (build maven-build)
141 (arguments (strip-keyword-arguments private-keywords arguments))))) 143 (arguments (strip-keyword-arguments private-keywords arguments)))))
142 144
143(define* (maven-build store name inputs 145(define* (maven-build name inputs
144 #:key (guile #f) 146 #:key
145 (outputs '("out")) 147 source (guile #f)
146 (search-paths '()) 148 (outputs '("out"))
147 (out-of-source? #t) 149 (search-paths '())
148 (validate-runpath? #t) 150 (out-of-source? #t)
149 (patch-shebangs? #t) 151 (validate-runpath? #t)
150 (strip-binaries? #t) 152 (patch-shebangs? #t)
151 (exclude %default-exclude) 153 (strip-binaries? #t)
152 (local-packages '()) 154 (exclude %default-exclude)
153 (tests? #t) 155 (local-packages '())
154 (strip-flags ''("--strip-debug")) 156 (tests? #t)
155 (strip-directories ''("lib" "lib64" "libexec" 157 (strip-flags ''("--strip-debug"))
156 "bin" "sbin")) 158 (strip-directories ''("lib" "lib64" "libexec"
157 (phases '(@ (guix build maven-build-system) 159 "bin" "sbin"))
158 %standard-phases)) 160 (phases '(@ (guix build maven-build-system)
159 (system (%current-system)) 161 %standard-phases))
160 (imported-modules %maven-build-system-modules) 162 (system (%current-system))
161 (modules '((guix build maven-build-system) 163 (imported-modules %maven-build-system-modules)
162 (guix build maven pom) 164 (modules '((guix build maven-build-system)
163 (guix build utils)))) 165 (guix build maven pom)
166 (guix build utils))))
164 "Build SOURCE using PATCHELF, and with INPUTS. This assumes that SOURCE 167 "Build SOURCE using PATCHELF, and with INPUTS. This assumes that SOURCE
165provides its own binaries." 168provides its own binaries."
166 (define builder 169 (define builder
167 `(begin 170 (with-imported-modules imported-modules
168 (use-modules ,@modules) 171 #~(begin
169 (maven-build #:source ,(match (assoc-ref inputs "source") 172 (use-modules #$@modules)
170 (((? derivation? source)) 173 (maven-build #:source #+source
171 (derivation->output-path source)) 174 #:system #$system
172 ((source) 175 #:outputs #$(outputs->gexp outputs)
173 source) 176 #:inputs #$(input-tuples->gexp inputs)
174 (source 177 #:search-paths '#$(map search-path-specification->sexp
175 source)) 178 search-paths)
176 #:system ,system 179 #:phases #$phases
177 #:outputs %outputs 180 #:exclude '#$exclude
178 #:inputs %build-inputs 181 #:local-packages '#$local-packages
179 #:search-paths ',(map search-path-specification->sexp 182 #:tests? #$tests?
180 search-paths) 183 #:out-of-source? #$out-of-source?
181 #:phases ,phases 184 #:validate-runpath? #$validate-runpath?
182 #:exclude (quote ,exclude) 185 #:patch-shebangs? #$patch-shebangs?
183 #:local-packages (quote ,local-packages) 186 #:strip-binaries? #$strip-binaries?
184 #:tests? ,tests? 187 #:strip-flags #$strip-flags
185 #:out-of-source? ,out-of-source? 188 #:strip-directories #$strip-directories))))
186 #:validate-runpath? ,validate-runpath? 189
187 #:patch-shebangs? ,patch-shebangs? 190 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
188 #:strip-binaries? ,strip-binaries? 191 system #:graft? #f)))
189 #:strip-flags ,strip-flags 192 (gexp->derivation name builder
190 #:strip-directories ,strip-directories))) 193 #:system system
191 194 #:guile-for-build guile)))
192 (define guile-for-build
193 (match guile
194 ((? package?)
195 (package-derivation store guile system #:graft? #f))
196 (#f ; the default
197 (let* ((distro (resolve-interface '(gnu packages commencement)))
198 (guile (module-ref distro 'guile-final)))
199 (package-derivation store guile system #:graft? #f)))))
200
201 (build-expression->derivation store name builder
202 #:system system
203 #:inputs inputs
204 #:modules imported-modules
205 #:outputs outputs
206 #:guile-for-build guile-for-build))
207 195
208(define maven-build-system 196(define maven-build-system
209 (build-system 197 (build-system
diff --git a/guix/build-system/meson.scm b/guix/build-system/meson.scm
index e04223381e7..19fbe54758e 100644
--- a/guix/build-system/meson.scm
+++ b/guix/build-system/meson.scm
@@ -1,6 +1,7 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com> 2;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com>
3;;; Copyright © 2018, 2019 Marius Bakke <mbakke@fastmail.com> 3;;; Copyright © 2018, 2019 Marius Bakke <mbakke@fastmail.com>
4;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
4;;; 5;;;
5;;; This file is part of GNU Guix. 6;;; This file is part of GNU Guix.
6;;; 7;;;
@@ -18,9 +19,10 @@
18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. 19;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19 20
20(define-module (guix build-system meson) 21(define-module (guix build-system meson)
21 #:use-module (guix store) 22 #:use-module (guix gexp)
22 #:use-module (guix utils) 23 #:use-module (guix utils)
23 #:use-module (guix derivations) 24 #:use-module (guix store)
25 #:use-module (guix monads)
24 #:use-module (guix search-paths) 26 #:use-module (guix search-paths)
25 #:use-module (guix build-system) 27 #:use-module (guix build-system)
26 #:use-module (guix build-system gnu) 28 #:use-module (guix build-system gnu)
@@ -66,7 +68,7 @@
66 #:rest arguments) 68 #:rest arguments)
67 "Return a bag for NAME." 69 "Return a bag for NAME."
68 (define private-keywords 70 (define private-keywords
69 `(#:source #:meson #:ninja #:inputs #:native-inputs #:outputs #:target)) 71 `(#:meson #:ninja #:inputs #:native-inputs #:outputs #:target))
70 72
71 (and (not target) ;; TODO: add support for cross-compilation. 73 (and (not target) ;; TODO: add support for cross-compilation.
72 (bag 74 (bag
@@ -85,8 +87,9 @@
85 (build meson-build) 87 (build meson-build)
86 (arguments (strip-keyword-arguments private-keywords arguments))))) 88 (arguments (strip-keyword-arguments private-keywords arguments)))))
87 89
88(define* (meson-build store name inputs 90(define* (meson-build name inputs
89 #:key (guile #f) 91 #:key
92 guile source
90 (outputs '("out")) 93 (outputs '("out"))
91 (configure-flags ''()) 94 (configure-flags ''())
92 (search-paths '()) 95 (search-paths '())
@@ -114,76 +117,48 @@
114 disallowed-references) 117 disallowed-references)
115 "Build SOURCE using MESON, and with INPUTS, assuming that SOURCE 118 "Build SOURCE using MESON, and with INPUTS, assuming that SOURCE
116has a 'meson.build' file." 119has a 'meson.build' file."
117
118 ;; TODO: Copied from build-system/gnu, factorize this!
119 (define canonicalize-reference
120 (match-lambda
121 ((? package? p)
122 (derivation->output-path (package-derivation store p system
123 #:graft? #f)))
124 (((? package? p) output)
125 (derivation->output-path (package-derivation store p system
126 #:graft? #f)
127 output))
128 ((? string? output)
129 output)))
130
131 (define builder 120 (define builder
132 `(let ((build-phases (if ,glib-or-gtk? 121 (with-imported-modules imported-modules
133 ,phases 122 #~(begin
134 (modify-phases ,phases 123 (use-modules #$@modules)
135 (delete 'glib-or-gtk-compile-schemas) 124
136 (delete 'glib-or-gtk-wrap))))) 125 (define build-phases
137 (use-modules ,@modules) 126 #$(if glib-or-gtk?
138 (meson-build #:source ,(match (assoc-ref inputs "source") 127 phases
139 (((? derivation? source)) 128 #~(modify-phases #$phases
140 (derivation->output-path source)) 129 (delete 'glib-or-gtk-compile-schemas)
141 ((source) 130 (delete 'glib-or-gtk-wrap))))
142 source)
143 (source
144 source))
145 #:system ,system
146 #:outputs %outputs
147 #:inputs %build-inputs
148 #:search-paths ',(map search-path-specification->sexp
149 search-paths)
150 #:phases build-phases
151 #:configure-flags ,configure-flags
152 #:build-type ,build-type
153 #:tests? ,tests?
154 #:test-target ,test-target
155 #:parallel-build? ,parallel-build?
156 #:parallel-tests? ,parallel-tests?
157 #:validate-runpath? ,validate-runpath?
158 #:patch-shebangs? ,patch-shebangs?
159 #:strip-binaries? ,strip-binaries?
160 #:strip-flags ,strip-flags
161 #:strip-directories ,strip-directories
162 #:elf-directories ,elf-directories)))
163 131
164 (define guile-for-build 132 #$(with-build-variables inputs outputs
165 (match guile 133 #~(meson-build #:source #+source
166 ((? package?) 134 #:system #$system
167 (package-derivation store guile system #:graft? #f)) 135 #:outputs %outputs
168 (#f ; the default 136 #:inputs %build-inputs
169 (let* ((distro (resolve-interface '(gnu packages commencement))) 137 #:search-paths '#$(map search-path-specification->sexp
170 (guile (module-ref distro 'guile-final))) 138 search-paths)
171 (package-derivation store guile system #:graft? #f))))) 139 #:phases build-phases
140 #:configure-flags #$configure-flags
141 #:build-type #$build-type
142 #:tests? #$tests?
143 #:test-target #$test-target
144 #:parallel-build? #$parallel-build?
145 #:parallel-tests? #$parallel-tests?
146 #:validate-runpath? #$validate-runpath?
147 #:patch-shebangs? #$patch-shebangs?
148 #:strip-binaries? #$strip-binaries?
149 #:strip-flags #$strip-flags
150 #:strip-directories #$strip-directories
151 #:elf-directories #$elf-directories)))))
172 152
173 (build-expression->derivation store name builder 153 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
174 #:system system 154 system #:graft? #f)))
175 #:inputs inputs 155 (gexp->derivation name builder
176 #:modules imported-modules 156 #:system system
177 #:outputs outputs 157 #:target #f
178 #:guile-for-build guile-for-build 158 #:substitutable? substitutable?
179 #:allowed-references 159 #:allowed-references allowed-references
180 (and allowed-references 160 #:disallowed-references disallowed-references
181 (map canonicalize-reference 161 #:guile-for-build guile)))
182 allowed-references))
183 #:disallowed-references
184 (and disallowed-references
185 (map canonicalize-reference
186 disallowed-references))))
187 162
188(define meson-build-system 163(define meson-build-system
189 (build-system 164 (build-system
diff --git a/guix/build-system/minify.scm b/guix/build-system/minify.scm
index 28a6781c06d..751312a5237 100644
--- a/guix/build-system/minify.scm
+++ b/guix/build-system/minify.scm
@@ -1,5 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net> 2;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
3;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
3;;; 4;;;
4;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
5;;; 6;;;
@@ -20,7 +21,8 @@
20 #:use-module (guix store) 21 #:use-module (guix store)
21 #:use-module (guix utils) 22 #:use-module (guix utils)
22 #:use-module (guix packages) 23 #:use-module (guix packages)
23 #:use-module (guix derivations) 24 #:use-module (guix gexp)
25 #:use-module (guix monads)
24 #:use-module (guix search-paths) 26 #:use-module (guix search-paths)
25 #:use-module (guix build-system) 27 #:use-module (guix build-system)
26 #:use-module (guix build-system gnu) 28 #:use-module (guix build-system gnu)
@@ -54,7 +56,7 @@
54 #:rest arguments) 56 #:rest arguments)
55 "Return a bag for NAME." 57 "Return a bag for NAME."
56 (define private-keywords 58 (define private-keywords
57 '(#:source #:target #:inputs #:native-inputs)) 59 '(#:target #:inputs #:native-inputs))
58 60
59 (bag 61 (bag
60 (name name) 62 (name name)
@@ -70,8 +72,9 @@
70 (build minify-build) 72 (build minify-build)
71 (arguments (strip-keyword-arguments private-keywords arguments)))) 73 (arguments (strip-keyword-arguments private-keywords arguments))))
72 74
73(define* (minify-build store name inputs 75(define* (minify-build name inputs
74 #:key 76 #:key
77 source
75 (javascript-files #f) 78 (javascript-files #f)
76 (phases '(@ (guix build minify-build-system) 79 (phases '(@ (guix build minify-build-system)
77 %standard-phases)) 80 %standard-phases))
@@ -84,38 +87,23 @@
84 (guix build utils)))) 87 (guix build utils))))
85 "Build SOURCE with INPUTS." 88 "Build SOURCE with INPUTS."
86 (define builder 89 (define builder
87 `(begin 90 (with-imported-modules imported-modules
88 (use-modules ,@modules) 91 #~(begin
89 (minify-build #:name ,name 92 (use-modules #$@modules)
90 #:source ,(match (assoc-ref inputs "source") 93 (minify-build #:name #$name
91 (((? derivation? source)) 94 #:source #+source
92 (derivation->output-path source)) 95 #:javascript-files #$javascript-files
93 ((source) 96 #:phases #$phases
94 source) 97 #:outputs #$(outputs->gexp outputs)
95 (source 98 #:search-paths '#$(map search-path-specification->sexp
96 source)) 99 search-paths)
97 #:javascript-files ,javascript-files 100 #:inputs #$(input-tuples->gexp inputs)))))
98 #:phases ,phases
99 #:outputs %outputs
100 #:search-paths ',(map search-path-specification->sexp
101 search-paths)
102 #:inputs %build-inputs)))
103 101
104 (define guile-for-build 102 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
105 (match guile 103 system #:graft? #f)))
106 ((? package?) 104 (gexp->derivation name builder
107 (package-derivation store guile system #:graft? #f)) 105 #:system system
108 (#f ; the default 106 #:guile-for-build guile)))
109 (let* ((distro (resolve-interface '(gnu packages commencement)))
110 (guile (module-ref distro 'guile-final)))
111 (package-derivation store guile system #:graft? #f)))))
112
113 (build-expression->derivation store name builder
114 #:inputs inputs
115 #:system system
116 #:modules imported-modules
117 #:outputs outputs
118 #:guile-for-build guile-for-build))
119 107
120(define minify-build-system 108(define minify-build-system
121 (build-system 109 (build-system
diff --git a/guix/build-system/node.scm b/guix/build-system/node.scm
index a8c5eed09ba..c174da98aa4 100644
--- a/guix/build-system/node.scm
+++ b/guix/build-system/node.scm
@@ -1,5 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org> 2;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
3;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
3;;; 4;;;
4;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
5;;; 6;;;
@@ -20,7 +21,8 @@
20 #:use-module (guix store) 21 #:use-module (guix store)
21 #:use-module (guix utils) 22 #:use-module (guix utils)
22 #:use-module (guix packages) 23 #:use-module (guix packages)
23 #:use-module (guix derivations) 24 #:use-module (guix gexp)
25 #:use-module (guix monads)
24 #:use-module (guix search-paths) 26 #:use-module (guix search-paths)
25 #:use-module (guix build-system) 27 #:use-module (guix build-system)
26 #:use-module (guix build-system gnu) 28 #:use-module (guix build-system gnu)
@@ -55,7 +57,7 @@ registry."
55 #:rest arguments) 57 #:rest arguments)
56 "Return a bag for NAME." 58 "Return a bag for NAME."
57 (define private-keywords 59 (define private-keywords
58 '(#:source #:target #:node #:inputs #:native-inputs)) 60 '(#:target #:node #:inputs #:native-inputs))
59 61
60 (and (not target) ;XXX: no cross-compilation 62 (and (not target) ;XXX: no cross-compilation
61 (bag 63 (bag
@@ -74,8 +76,9 @@ registry."
74 (build node-build) 76 (build node-build)
75 (arguments (strip-keyword-arguments private-keywords arguments))))) 77 (arguments (strip-keyword-arguments private-keywords arguments)))))
76 78
77(define* (node-build store name inputs 79(define* (node-build name inputs
78 #:key 80 #:key
81 source
79 (npm-flags ''()) 82 (npm-flags ''())
80 (tests? #t) 83 (tests? #t)
81 (phases '(@ (guix build node-build-system) 84 (phases '(@ (guix build node-build-system)
@@ -91,40 +94,25 @@ registry."
91 (guix build utils)))) 94 (guix build utils))))
92 "Build SOURCE using NODE and INPUTS." 95 "Build SOURCE using NODE and INPUTS."
93 (define builder 96 (define builder
94 `(begin 97 (with-imported-modules imported-modules
95 (use-modules ,@modules) 98 #~(begin
96 (node-build #:name ,name 99 (use-modules #$@modules)
97 #:source ,(match (assoc-ref inputs "source") 100 (node-build #:name #$name
98 (((? derivation? source)) 101 #:source #+source
99 (derivation->output-path source)) 102 #:system #$system
100 ((source) 103 #:npm-flags #$npm-flags
101 source) 104 #:tests? #$tests?
102 (source 105 #:phases #$phases
103 source)) 106 #:outputs #$(outputs->gexp outputs)
104 #:system ,system 107 #:search-paths '#$(map search-path-specification->sexp
105 #:npm-flags ,npm-flags 108 search-paths)
106 #:tests? ,tests? 109 #:inputs #$(input-tuples->gexp inputs)))))
107 #:phases ,phases
108 #:outputs %outputs
109 #:search-paths ',(map search-path-specification->sexp
110 search-paths)
111 #:inputs %build-inputs)))
112 110
113 (define guile-for-build 111 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
114 (match guile 112 system #:graft? #f)))
115 ((? package?) 113 (gexp->derivation name builder
116 (package-derivation store guile system #:graft? #f)) 114 #:system system
117 (#f 115 #:guile-for-build guile)))
118 (let* ((distro (resolve-interface '(gnu packages commencement)))
119 (guile (module-ref distro 'guile-final)))
120 (package-derivation store guile system #:graft? #f)))))
121
122 (build-expression->derivation store name builder
123 #:inputs inputs
124 #:system system
125 #:modules imported-modules
126 #:outputs outputs
127 #:guile-for-build guile-for-build))
128 116
129(define node-build-system 117(define node-build-system
130 (build-system 118 (build-system
diff --git a/guix/build-system/ocaml.scm b/guix/build-system/ocaml.scm
index 5513216c25f..2f60f0d5341 100644
--- a/guix/build-system/ocaml.scm
+++ b/guix/build-system/ocaml.scm
@@ -1,6 +1,7 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu> 2;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu>
3;;; Copyright © 2017 Ben Woodcroft <donttrustben@gmail.com> 3;;; Copyright © 2017 Ben Woodcroft <donttrustben@gmail.com>
4;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
4;;; 5;;;
5;;; This file is part of GNU Guix. 6;;; This file is part of GNU Guix.
6;;; 7;;;
@@ -19,7 +20,7 @@
19(define-module (guix build-system ocaml) 20(define-module (guix build-system ocaml)
20 #:use-module (guix store) 21 #:use-module (guix store)
21 #:use-module (guix utils) 22 #:use-module (guix utils)
22 #:use-module (guix derivations) 23 #:use-module (guix gexp)
23 #:use-module (guix search-paths) 24 #:use-module (guix search-paths)
24 #:use-module (guix build-system) 25 #:use-module (guix build-system)
25 #:use-module (guix build-system gnu) 26 #:use-module (guix build-system gnu)
@@ -206,7 +207,7 @@ pre-defined variants."
206 #:rest arguments) 207 #:rest arguments)
207 "Return a bag for NAME." 208 "Return a bag for NAME."
208 (define private-keywords 209 (define private-keywords
209 '(#:source #:target #:ocaml #:findlib #:inputs #:native-inputs)) 210 '(#:target #:ocaml #:findlib #:inputs #:native-inputs))
210 211
211 (and (not target) ;XXX: no cross-compilation 212 (and (not target) ;XXX: no cross-compilation
212 (bag 213 (bag
@@ -226,8 +227,9 @@ pre-defined variants."
226 (build ocaml-build) 227 (build ocaml-build)
227 (arguments (strip-keyword-arguments private-keywords arguments))))) 228 (arguments (strip-keyword-arguments private-keywords arguments)))))
228 229
229(define* (ocaml-build store name inputs 230(define* (ocaml-build name inputs
230 #:key (guile #f) 231 #:key
232 guile source
231 (outputs '("out")) (configure-flags ''()) 233 (outputs '("out")) (configure-flags ''())
232 (search-paths '()) 234 (search-paths '())
233 (make-flags ''()) 235 (make-flags ''())
@@ -253,51 +255,40 @@ pre-defined variants."
253 "Build SOURCE using OCAML, and with INPUTS. This assumes that SOURCE 255 "Build SOURCE using OCAML, and with INPUTS. This assumes that SOURCE
254provides a 'setup.ml' file as its build system." 256provides a 'setup.ml' file as its build system."
255 (define builder 257 (define builder
256 `(begin 258 (with-imported-modules imported-modules
257 (use-modules ,@modules) 259 #~(begin
258 (ocaml-build #:source ,(match (assoc-ref inputs "source") 260 (use-modules #$@modules)
259 (((? derivation? source)) 261 (ocaml-build #:source #$source
260 (derivation->output-path source)) 262 #:system #$system
261 ((source) 263 #:outputs (list #$@(map (lambda (name)
262 source) 264 #~(cons #$name
263 (source 265 (ungexp output name)))
264 source)) 266 outputs))
265 #:system ,system 267 #:inputs (map (lambda (tuple)
266 #:outputs %outputs 268 (apply cons tuple))
267 #:inputs %build-inputs 269 '#$inputs)
268 #:search-paths ',(map search-path-specification->sexp 270 #:search-paths '#$(map search-path-specification->sexp
269 search-paths) 271 search-paths)
270 #:phases ,phases 272 #:phases #$phases
271 #:configure-flags ,configure-flags 273 #:configure-flags #$configure-flags
272 #:test-flags ,test-flags 274 #:test-flags #$test-flags
273 #:make-flags ,make-flags 275 #:make-flags #$make-flags
274 #:build-flags ,build-flags 276 #:build-flags #$build-flags
275 #:out-of-source? ,out-of-source? 277 #:out-of-source? #$out-of-source?
276 #:use-make? ,use-make? 278 #:use-make? #$use-make?
277 #:tests? ,tests? 279 #:tests? #$tests?
278 #:test-target ,test-target 280 #:test-target #$test-target
279 #:install-target ,install-target 281 #:install-target #$install-target
280 #:validate-runpath? ,validate-runpath? 282 #:validate-runpath? #$validate-runpath?
281 #:patch-shebangs? ,patch-shebangs? 283 #:patch-shebangs? #$patch-shebangs?
282 #:strip-binaries? ,strip-binaries? 284 #:strip-binaries? #$strip-binaries?
283 #:strip-flags ,strip-flags 285 #:strip-flags #$strip-flags
284 #:strip-directories ,strip-directories))) 286 #:strip-directories #$strip-directories))))
285 287
286 (define guile-for-build 288 (gexp->derivation name builder
287 (match guile 289 #:system system
288 ((? package?) 290 #:target #f
289 (package-derivation store guile system #:graft? #f)) 291 #:guile-for-build guile))
290 (#f ; the default
291 (let* ((distro (resolve-interface '(gnu packages commencement)))
292 (guile (module-ref distro 'guile-final)))
293 (package-derivation store guile system #:graft? #f)))))
294
295 (build-expression->derivation store name builder
296 #:system system
297 #:inputs inputs
298 #:modules imported-modules
299 #:outputs outputs
300 #:guile-for-build guile-for-build))
301 292
302(define ocaml-build-system 293(define ocaml-build-system
303 (build-system 294 (build-system
diff --git a/guix/build-system/perl.scm b/guix/build-system/perl.scm
index 06af1dd20e7..32045ef6de0 100644
--- a/guix/build-system/perl.scm
+++ b/guix/build-system/perl.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2013, 2014, 2015, 2021 Ludovic Courtès <ludo@gnu.org>
3;;; 3;;;
4;;; This file is part of GNU Guix. 4;;; This file is part of GNU Guix.
5;;; 5;;;
@@ -19,6 +19,8 @@
19(define-module (guix build-system perl) 19(define-module (guix build-system perl)
20 #:use-module (guix store) 20 #:use-module (guix store)
21 #:use-module (guix utils) 21 #:use-module (guix utils)
22 #:use-module (guix gexp)
23 #:use-module (guix monads)
22 #:use-module (guix derivations) 24 #:use-module (guix derivations)
23 #:use-module (guix search-paths) 25 #:use-module (guix search-paths)
24 #:use-module (guix build-system) 26 #:use-module (guix build-system)
@@ -57,7 +59,7 @@
57 #:rest arguments) 59 #:rest arguments)
58 "Return a bag for NAME." 60 "Return a bag for NAME."
59 (define private-keywords 61 (define private-keywords
60 '(#:source #:target #:perl #:inputs #:native-inputs)) 62 '(#:target #:perl #:inputs #:native-inputs))
61 63
62 (and (not target) ;XXX: no cross-compilation 64 (and (not target) ;XXX: no cross-compilation
63 (bag 65 (bag
@@ -76,8 +78,8 @@
76 (build perl-build) 78 (build perl-build)
77 (arguments (strip-keyword-arguments private-keywords arguments))))) 79 (arguments (strip-keyword-arguments private-keywords arguments)))))
78 80
79(define* (perl-build store name inputs 81(define* (perl-build name inputs
80 #:key 82 #:key source
81 (search-paths '()) 83 (search-paths '())
82 (tests? #t) 84 (tests? #t)
83 (parallel-build? #t) 85 (parallel-build? #t)
@@ -95,46 +97,34 @@
95 (guix build utils)))) 97 (guix build utils))))
96 "Build SOURCE using PERL, and with INPUTS. This assumes that SOURCE 98 "Build SOURCE using PERL, and with INPUTS. This assumes that SOURCE
97provides a `Makefile.PL' file as its build system." 99provides a `Makefile.PL' file as its build system."
98 (define builder 100 (define build
99 `(begin 101 (with-imported-modules imported-modules
100 (use-modules ,@modules) 102 #~(begin
101 (perl-build #:name ,name 103 (use-modules #$@modules)
102 #:source ,(match (assoc-ref inputs "source")
103 (((? derivation? source))
104 (derivation->output-path source))
105 ((source)
106 source)
107 (source
108 source))
109 #:search-paths ',(map search-path-specification->sexp
110 search-paths)
111 #:make-maker? ,make-maker?
112 #:make-maker-flags ,make-maker-flags
113 #:module-build-flags ,module-build-flags
114 #:phases ,phases
115 #:system ,system
116 #:test-target "test"
117 #:tests? ,tests?
118 #:parallel-build? ,parallel-build?
119 #:parallel-tests? ,parallel-tests?
120 #:outputs %outputs
121 #:inputs %build-inputs)))
122 104
123 (define guile-for-build 105 #$(with-build-variables inputs outputs
124 (match guile 106 #~(perl-build #:name #$name
125 ((? package?) 107 #:source #+source
126 (package-derivation store guile system #:graft? #f)) 108 #:search-paths '#$(map search-path-specification->sexp
127 (#f ; the default 109 search-paths)
128 (let* ((distro (resolve-interface '(gnu packages commencement))) 110 #:make-maker? #$make-maker?
129 (guile (module-ref distro 'guile-final))) 111 #:make-maker-flags #$make-maker-flags
130 (package-derivation store guile system #:graft? #f))))) 112 #:module-build-flags #$module-build-flags
113 #:phases #$phases
114 #:system #$system
115 #:test-target "test"
116 #:tests? #$tests?
117 #:parallel-build? #$parallel-build?
118 #:parallel-tests? #$parallel-tests?
119 #:outputs %outputs
120 #:inputs %build-inputs)))))
131 121
132 (build-expression->derivation store name builder 122 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
133 #:system system 123 system #:graft? #f)))
134 #:inputs inputs 124 (gexp->derivation name build
135 #:modules imported-modules 125 #:system system
136 #:outputs outputs 126 #:target #f
137 #:guile-for-build guile-for-build)) 127 #:guile-for-build guile)))
138 128
139(define perl-build-system 129(define perl-build-system
140 (build-system 130 (build-system
diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm
index 9f3159a960f..018fda9b20c 100644
--- a/guix/build-system/python.scm
+++ b/guix/build-system/python.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2021 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> 3;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
4;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> 4;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
5;;; Copyright © 2021 Lars-Dominik Braun <lars@6xq.net> 5;;; Copyright © 2021 Lars-Dominik Braun <lars@6xq.net>
@@ -25,6 +25,8 @@
25 #:use-module (guix store) 25 #:use-module (guix store)
26 #:use-module (guix utils) 26 #:use-module (guix utils)
27 #:use-module (guix memoization) 27 #:use-module (guix memoization)
28 #:use-module (guix gexp)
29 #:use-module (guix monads)
28 #:use-module (guix packages) 30 #:use-module (guix packages)
29 #:use-module (guix derivations) 31 #:use-module (guix derivations)
30 #:use-module (guix search-paths) 32 #:use-module (guix search-paths)
@@ -147,7 +149,7 @@ pre-defined variants."
147 #:rest arguments) 149 #:rest arguments)
148 "Return a bag for NAME." 150 "Return a bag for NAME."
149 (define private-keywords 151 (define private-keywords
150 '(#:source #:target #:python #:inputs #:native-inputs)) 152 '(#:target #:python #:inputs #:native-inputs))
151 153
152 (and (not target) ;XXX: no cross-compilation 154 (and (not target) ;XXX: no cross-compilation
153 (bag 155 (bag
@@ -167,8 +169,8 @@ pre-defined variants."
167 (build python-build) 169 (build python-build)
168 (arguments (strip-keyword-arguments private-keywords arguments))))) 170 (arguments (strip-keyword-arguments private-keywords arguments)))))
169 171
170(define* (python-build store name inputs 172(define* (python-build name inputs
171 #:key 173 #:key source
172 (tests? #t) 174 (tests? #t)
173 (test-target "test") 175 (test-target "test")
174 (use-setuptools? #t) 176 (use-setuptools? #t)
@@ -184,43 +186,32 @@ pre-defined variants."
184 (guix build utils)))) 186 (guix build utils))))
185 "Build SOURCE using PYTHON, and with INPUTS. This assumes that SOURCE 187 "Build SOURCE using PYTHON, and with INPUTS. This assumes that SOURCE
186provides a 'setup.py' file as its build system." 188provides a 'setup.py' file as its build system."
187 (define builder 189 (define build
188 `(begin 190 (with-imported-modules imported-modules
189 (use-modules ,@modules) 191 #~(begin
190 (python-build #:name ,name 192 (use-modules #$@modules)
191 #:source ,(match (assoc-ref inputs "source") 193
192 (((? derivation? source)) 194 #$(with-build-variables inputs outputs
193 (derivation->output-path source)) 195 #~(python-build #:name #$name
194 ((source) 196 #:source #+source
195 source) 197 #:configure-flags #$configure-flags
196 (source 198 #:use-setuptools? #$use-setuptools?
197 source)) 199 #:system #$system
198 #:configure-flags ,configure-flags 200 #:test-target #$test-target
199 #:system ,system 201 #:tests? #$tests?
200 #:test-target ,test-target 202 #:phases #$phases
201 #:tests? ,tests? 203 #:outputs %outputs
202 #:use-setuptools? ,use-setuptools? 204 #:search-paths '#$(map search-path-specification->sexp
203 #:phases ,phases 205 search-paths)
204 #:outputs %outputs 206 #:inputs %build-inputs)))))
205 #:search-paths ',(map search-path-specification->sexp 207
206 search-paths) 208
207 #:inputs %build-inputs))) 209 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
208 210 system #:graft? #f)))
209 (define guile-for-build 211 (gexp->derivation name build
210 (match guile 212 #:system system
211 ((? package?) 213 #:target #f
212 (package-derivation store guile system #:graft? #f)) 214 #:guile-for-build guile)))
213 (#f ; the default
214 (let* ((distro (resolve-interface '(gnu packages commencement)))
215 (guile (module-ref distro 'guile-final)))
216 (package-derivation store guile system #:graft? #f)))))
217
218 (build-expression->derivation store name builder
219 #:inputs inputs
220 #:system system
221 #:modules imported-modules
222 #:outputs outputs
223 #:guile-for-build guile-for-build))
224 215
225(define python-build-system 216(define python-build-system
226 (build-system 217 (build-system
diff --git a/guix/build-system/qt.scm b/guix/build-system/qt.scm
index 118022ec458..7df431a68d9 100644
--- a/guix/build-system/qt.scm
+++ b/guix/build-system/qt.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2013, 2014, 2015, 2021 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> 3;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
4;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> 4;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
5;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com> 5;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
@@ -22,7 +22,8 @@
22(define-module (guix build-system qt) 22(define-module (guix build-system qt)
23 #:use-module (guix store) 23 #:use-module (guix store)
24 #:use-module (guix utils) 24 #:use-module (guix utils)
25 #:use-module (guix derivations) 25 #:use-module (guix gexp)
26 #:use-module (guix monads)
26 #:use-module (guix search-paths) 27 #:use-module (guix search-paths)
27 #:use-module (guix build-system) 28 #:use-module (guix build-system)
28 #:use-module (guix build-system cmake) 29 #:use-module (guix build-system cmake)
@@ -71,7 +72,7 @@
71 #:rest arguments) 72 #:rest arguments)
72 "Return a bag for NAME." 73 "Return a bag for NAME."
73 (define private-keywords 74 (define private-keywords
74 `(#:source #:cmake #:inputs #:native-inputs #:outputs 75 `(#:cmake #:inputs #:native-inputs #:outputs
75 ,@(if target '() '(#:target)))) 76 ,@(if target '() '(#:target))))
76 77
77 (bag 78 (bag
@@ -105,8 +106,9 @@
105 (arguments (strip-keyword-arguments private-keywords arguments)))) 106 (arguments (strip-keyword-arguments private-keywords arguments))))
106 107
107 108
108(define* (qt-build store name inputs 109(define* (qt-build name inputs
109 #:key (guile #f) 110 #:key
111 source (guile #f)
110 (outputs '("out")) (configure-flags ''()) 112 (outputs '("out")) (configure-flags ''())
111 (search-paths '()) 113 (search-paths '())
112 (make-flags ''()) 114 (make-flags ''())
@@ -131,60 +133,46 @@
131 "Build SOURCE using CMAKE, and with INPUTS. This assumes that SOURCE 133 "Build SOURCE using CMAKE, and with INPUTS. This assumes that SOURCE
132provides a 'CMakeLists.txt' file as its build system." 134provides a 'CMakeLists.txt' file as its build system."
133 (define builder 135 (define builder
134 `(begin 136 (with-imported-modules imported-modules
135 (use-modules ,@modules) 137 #~(begin
136 (qt-build #:source ,(match (assoc-ref inputs "source") 138 (use-modules #$@modules)
137 (((? derivation? source)) 139 (qt-build #:source #+source
138 (derivation->output-path source)) 140 #:system #$system
139 ((source) 141 #:outputs #$(outputs->gexp outputs)
140 source) 142 #:inputs #$(input-tuples->gexp inputs)
141 (source 143 #:search-paths '#$(map search-path-specification->sexp
142 source)) 144 search-paths)
143 #:system ,system 145 #:phases #$phases
144 #:outputs %outputs 146 #:qt-wrap-excluded-outputs #$qt-wrap-excluded-outputs
145 #:inputs %build-inputs 147 #:configure-flags #$configure-flags
146 #:search-paths ',(map search-path-specification->sexp 148 #:make-flags #$make-flags
147 search-paths) 149 #:out-of-source? #$out-of-source?
148 #:phases ,phases 150 #:build-type #$build-type
149 #:qt-wrap-excluded-outputs ,qt-wrap-excluded-outputs 151 #:tests? #$tests?
150 #:configure-flags ,configure-flags 152 #:test-target #$test-target
151 #:make-flags ,make-flags 153 #:parallel-build? #$parallel-build?
152 #:out-of-source? ,out-of-source? 154 #:parallel-tests? #$parallel-tests?
153 #:build-type ,build-type 155 #:validate-runpath? #$validate-runpath?
154 #:tests? ,tests? 156 #:patch-shebangs? #$patch-shebangs?
155 #:test-target ,test-target 157 #:strip-binaries? #$strip-binaries?
156 #:parallel-build? ,parallel-build? 158 #:strip-flags #$strip-flags
157 #:parallel-tests? ,parallel-tests? 159 #:strip-directories #$strip-directories))))
158 #:validate-runpath? ,validate-runpath?
159 #:patch-shebangs? ,patch-shebangs?
160 #:strip-binaries? ,strip-binaries?
161 #:strip-flags ,strip-flags
162 #:strip-directories ,strip-directories)))
163 160
164 (define guile-for-build 161 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
165 (match guile 162 system #:graft? #f)))
166 ((? package?) 163 (gexp->derivation name builder
167 (package-derivation store guile system #:graft? #f)) 164 #:system system
168 (#f ; the default 165 #:guile-for-build guile)))
169 (let* ((distro (resolve-interface '(gnu packages commencement)))
170 (guile (module-ref distro 'guile-final)))
171 (package-derivation store guile system #:graft? #f)))))
172
173 (build-expression->derivation store name builder
174 #:system system
175 #:inputs inputs
176 #:modules imported-modules
177 #:outputs outputs
178 #:guile-for-build guile-for-build))
179 166
180 167
181;;; 168;;;
182;;; Cross-compilation. 169;;; Cross-compilation.
183;;; 170;;;
184 171
185(define* (qt-cross-build store name 172(define* (qt-cross-build name
186 #:key 173 #:key
187 target native-drvs target-drvs 174 source target
175 build-inputs target-inputs host-inputs
188 (guile #f) 176 (guile #f)
189 (outputs '("out")) 177 (outputs '("out"))
190 (configure-flags ''()) 178 (configure-flags ''())
@@ -193,7 +181,7 @@ provides a 'CMakeLists.txt' file as its build system."
193 (make-flags ''()) 181 (make-flags ''())
194 (out-of-source? #t) 182 (out-of-source? #t)
195 (build-type "RelWithDebInfo") 183 (build-type "RelWithDebInfo")
196 (tests? #f) ; nothing can be done 184 (tests? #f) ; nothing can be done
197 (test-target "test") 185 (test-target "test")
198 (parallel-build? #t) (parallel-tests? #f) 186 (parallel-build? #t) (parallel-tests? #f)
199 (validate-runpath? #t) 187 (validate-runpath? #t)
@@ -214,77 +202,52 @@ provides a 'CMakeLists.txt' file as its build system."
214with INPUTS. This assumes that SOURCE provides a 'CMakeLists.txt' file as its 202with INPUTS. This assumes that SOURCE provides a 'CMakeLists.txt' file as its
215build system." 203build system."
216 (define builder 204 (define builder
217 `(begin 205 (with-imported-modules imported-modules
218 (use-modules ,@modules) 206 #~(begin
219 (let () 207 (use-modules #$@modules)
220 (define %build-host-inputs 208
221 ',(map (match-lambda 209 (define %build-host-inputs
222 ((name (? derivation? drv) sub ...) 210 #+(input-tuples->gexp build-inputs))
223 `(,name . ,(apply derivation->output-path drv sub)))
224 ((name path)
225 `(,name . ,path)))
226 native-drvs))
227 211
228 (define %build-target-inputs 212 (define %build-target-inputs
229 ',(map (match-lambda 213 (append #$(input-tuples->gexp host-inputs)
230 ((name (? derivation? drv) sub ...) 214 #+(input-tuples->gexp target-inputs)))
231 `(,name . ,(apply derivation->output-path drv sub)))
232 ((name (? package? pkg) sub ...)
233 (let ((drv (package-cross-derivation store pkg
234 target system)))
235 `(,name . ,(apply derivation->output-path drv sub))))
236 ((name path)
237 `(,name . ,path)))
238 target-drvs))
239 215
240 (qt-build #:source ,(match (assoc-ref native-drvs "source") 216 (define %outputs
241 (((? derivation? source)) 217 #$(outputs->gexp outputs))
242 (derivation->output-path source))
243 ((source)
244 source)
245 (source
246 source))
247 #:system ,system
248 #:build ,build
249 #:target ,target
250 #:outputs %outputs
251 #:inputs %build-target-inputs
252 #:native-inputs %build-host-inputs
253 #:search-paths ',(map search-path-specification->sexp
254 search-paths)
255 #:native-search-paths ',(map
256 search-path-specification->sexp
257 native-search-paths)
258 #:phases ,phases
259 #:configure-flags ,configure-flags
260 #:make-flags ,make-flags
261 #:out-of-source? ,out-of-source?
262 #:build-type ,build-type
263 #:tests? ,tests?
264 #:test-target ,test-target
265 #:parallel-build? ,parallel-build?
266 #:parallel-tests? ,parallel-tests?
267 #:validate-runpath? ,validate-runpath?
268 #:patch-shebangs? ,patch-shebangs?
269 #:strip-binaries? ,strip-binaries?
270 #:strip-flags ,strip-flags
271 #:strip-directories ,strip-directories))))
272 218
273 (define guile-for-build 219 (qt-build #:source #+source
274 (match guile 220 #:system #$system
275 ((? package?) 221 #:build #$build
276 (package-derivation store guile system #:graft? #f)) 222 #:target #$target
277 (#f ; the default 223 #:outputs %outputs
278 (let* ((distro (resolve-interface '(gnu packages commencement))) 224 #:inputs %build-target-inputs
279 (guile (module-ref distro 'guile-final))) 225 #:native-inputs %build-host-inputs
280 (package-derivation store guile system #:graft? #f))))) 226 #:search-paths '#$(map search-path-specification->sexp
227 search-paths)
228 #:native-search-paths '#$(map
229 search-path-specification->sexp
230 native-search-paths)
231 #:phases #$phases
232 #:configure-flags #$configure-flags
233 #:make-flags #$make-flags
234 #:out-of-source? #$out-of-source?
235 #:build-type #$build-type
236 #:tests? #$tests?
237 #:test-target #$test-target
238 #:parallel-build? #$parallel-build?
239 #:parallel-tests? #$parallel-tests?
240 #:validate-runpath? #$validate-runpath?
241 #:patch-shebangs? #$patch-shebangs?
242 #:strip-binaries? #$strip-binaries?
243 #:strip-flags #$strip-flags
244 #:strip-directories #$strip-directories))))
281 245
282 (build-expression->derivation store name builder 246 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
283 #:system system 247 system #:graft? #f)))
284 #:inputs (append native-drvs target-drvs) 248 (gexp->derivation name builder
285 #:outputs outputs 249 #:system system
286 #:modules imported-modules 250 #:guile-for-build guile)))
287 #:guile-for-build guile-for-build))
288 251
289(define qt-build-system 252(define qt-build-system
290 (build-system 253 (build-system
diff --git a/guix/build-system/r.scm b/guix/build-system/r.scm
index e2bf41f18dd..12b7df66a68 100644
--- a/guix/build-system/r.scm
+++ b/guix/build-system/r.scm
@@ -1,5 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2015, 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net> 2;;; Copyright © 2015, 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
3;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
3;;; 4;;;
4;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
5;;; 6;;;
@@ -20,7 +21,8 @@
20 #:use-module (guix store) 21 #:use-module (guix store)
21 #:use-module (guix utils) 22 #:use-module (guix utils)
22 #:use-module (guix packages) 23 #:use-module (guix packages)
23 #:use-module (guix derivations) 24 #:use-module (guix gexp)
25 #:use-module (guix monads)
24 #:use-module (guix search-paths) 26 #:use-module (guix search-paths)
25 #:use-module (guix build-system) 27 #:use-module (guix build-system)
26 #:use-module (guix build-system gnu) 28 #:use-module (guix build-system gnu)
@@ -82,7 +84,7 @@ release corresponding to NAME and VERSION."
82 #:rest arguments) 84 #:rest arguments)
83 "Return a bag for NAME." 85 "Return a bag for NAME."
84 (define private-keywords 86 (define private-keywords
85 '(#:source #:target #:r #:inputs #:native-inputs)) 87 '(#:target #:r #:inputs #:native-inputs))
86 88
87 (and (not target) ;XXX: no cross-compilation 89 (and (not target) ;XXX: no cross-compilation
88 (bag 90 (bag
@@ -101,8 +103,9 @@ release corresponding to NAME and VERSION."
101 (build r-build) 103 (build r-build)
102 (arguments (strip-keyword-arguments private-keywords arguments))))) 104 (arguments (strip-keyword-arguments private-keywords arguments)))))
103 105
104(define* (r-build store name inputs 106(define* (r-build name inputs
105 #:key 107 #:key
108 source
106 (tests? #t) 109 (tests? #t)
107 (test-target "tests") 110 (test-target "tests")
108 (configure-flags ''()) 111 (configure-flags ''())
@@ -118,42 +121,27 @@ release corresponding to NAME and VERSION."
118 (guix build utils)))) 121 (guix build utils))))
119 "Build SOURCE with INPUTS." 122 "Build SOURCE with INPUTS."
120 (define builder 123 (define builder
121 `(begin 124 (with-imported-modules imported-modules
122 (use-modules ,@modules) 125 #~(begin
123 (r-build #:name ,name 126 (use-modules #$@modules)
124 #:source ,(match (assoc-ref inputs "source") 127 (r-build #:name #$name
125 (((? derivation? source)) 128 #:source #+source
126 (derivation->output-path source)) 129 #:configure-flags #$configure-flags
127 ((source) 130 #:system #$system
128 source) 131 #:tests? #$tests?
129 (source 132 #:test-target #$test-target
130 source)) 133 #:phases #$phases
131 #:configure-flags ,configure-flags 134 #:outputs #$(outputs->gexp outputs)
132 #:system ,system 135 #:search-paths '#$(map search-path-specification->sexp
133 #:tests? ,tests? 136 search-paths)
134 #:test-target ,test-target 137 #:inputs #$(input-tuples->gexp inputs)))))
135 #:phases ,phases
136 #:outputs %outputs
137 #:search-paths ',(map search-path-specification->sexp
138 search-paths)
139 #:inputs %build-inputs)))
140 138
141 (define guile-for-build 139 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
142 (match guile 140 system #:graft? #f)))
143 ((? package?) 141 (gexp->derivation name builder
144 (package-derivation store guile system #:graft? #f)) 142 #:system system
145 (#f ; the default 143 #:guile-for-build guile
146 (let* ((distro (resolve-interface '(gnu packages commencement))) 144 #:substitutable? substitutable?)))
147 (guile (module-ref distro 'guile-final)))
148 (package-derivation store guile system #:graft? #f)))))
149
150 (build-expression->derivation store name builder
151 #:inputs inputs
152 #:system system
153 #:modules imported-modules
154 #:outputs outputs
155 #:guile-for-build guile-for-build
156 #:substitutable? substitutable?))
157 145
158(define r-build-system 146(define r-build-system
159 (build-system 147 (build-system
diff --git a/guix/build-system/rakudo.scm b/guix/build-system/rakudo.scm
index a02e2bad3ad..eab41e2cb9a 100644
--- a/guix/build-system/rakudo.scm
+++ b/guix/build-system/rakudo.scm
@@ -1,5 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il> 2;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il>
3;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
3;;; 4;;;
4;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
5;;; 6;;;
@@ -19,7 +20,8 @@
19(define-module (guix build-system rakudo) 20(define-module (guix build-system rakudo)
20 #:use-module (guix store) 21 #:use-module (guix store)
21 #:use-module (guix utils) 22 #:use-module (guix utils)
22 #:use-module (guix derivations) 23 #:use-module (guix gexp)
24 #:use-module (guix monads)
23 #:use-module (guix search-paths) 25 #:use-module (guix search-paths)
24 #:use-module (guix build-system) 26 #:use-module (guix build-system)
25 #:use-module (guix build-system gnu) 27 #:use-module (guix build-system gnu)
@@ -71,7 +73,7 @@
71 #:rest arguments) 73 #:rest arguments)
72 "Return a bag for NAME." 74 "Return a bag for NAME."
73 (define private-keywords 75 (define private-keywords
74 '(#:source #:target #:rakudo #:prove6 #:zef #:inputs #:native-inputs)) 76 '(#:target #:rakudo #:prove6 #:zef #:inputs #:native-inputs))
75 77
76 (and (not target) ;XXX: no cross-compilation 78 (and (not target) ;XXX: no cross-compilation
77 (bag 79 (bag
@@ -96,8 +98,9 @@
96 (build rakudo-build) 98 (build rakudo-build)
97 (arguments (strip-keyword-arguments private-keywords arguments))))) 99 (arguments (strip-keyword-arguments private-keywords arguments)))))
98 100
99(define* (rakudo-build store name inputs 101(define* (rakudo-build name inputs
100 #:key 102 #:key
103 source
101 (search-paths '()) 104 (search-paths '())
102 (tests? #t) 105 (tests? #t)
103 (phases '(@ (guix build rakudo-build-system) 106 (phases '(@ (guix build rakudo-build-system)
@@ -112,39 +115,24 @@
112 (guix build utils)))) 115 (guix build utils))))
113 "Build SOURCE using PERL6, and with INPUTS." 116 "Build SOURCE using PERL6, and with INPUTS."
114 (define builder 117 (define builder
115 `(begin 118 (with-imported-modules imported-modules
116 (use-modules ,@modules) 119 #~(begin
117 (rakudo-build #:name ,name 120 (use-modules #$@modules)
118 #:source ,(match (assoc-ref inputs "source") 121 (rakudo-build #:name #$name
119 (((? derivation? source)) 122 #:source #+source
120 (derivation->output-path source)) 123 #:search-paths '#$(map search-path-specification->sexp
121 ((source) 124 search-paths)
122 source) 125 #:phases #$phases
123 (source 126 #:system #$system
124 source)) 127 #:tests? #$tests?
125 #:search-paths ',(map search-path-specification->sexp 128 #:outputs #$(outputs->gexp outputs)
126 search-paths) 129 #:inputs #$(input-tuples->gexp inputs)))))
127 #:phases ,phases
128 #:system ,system
129 #:tests? ,tests?
130 #:outputs %outputs
131 #:inputs %build-inputs)))
132 130
133 (define guile-for-build 131 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
134 (match guile 132 system #:graft? #f)))
135 ((? package?) 133 (gexp->derivation name builder
136 (package-derivation store guile system #:graft? #f)) 134 #:system system
137 (#f ; the default 135 #:guile-for-build guile)))
138 (let* ((distro (resolve-interface '(gnu packages commencement)))
139 (guile (module-ref distro 'guile-final)))
140 (package-derivation store guile system #:graft? #f)))))
141
142 (build-expression->derivation store name builder
143 #:system system
144 #:inputs inputs
145 #:modules imported-modules
146 #:outputs outputs
147 #:guile-for-build guile-for-build))
148 136
149(define rakudo-build-system 137(define rakudo-build-system
150 (build-system 138 (build-system
diff --git a/guix/build-system/renpy.scm b/guix/build-system/renpy.scm
index 35edc0056db..5c65f554555 100644
--- a/guix/build-system/renpy.scm
+++ b/guix/build-system/renpy.scm
@@ -1,5 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2021 Leo Prikler <leo.prikler@student.tugraz.at> 2;;; Copyright © 2021 Leo Prikler <leo.prikler@student.tugraz.at>
3;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
3;;; 4;;;
4;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
5;;; 6;;;
@@ -21,7 +22,8 @@
21 #:use-module (guix utils) 22 #:use-module (guix utils)
22 #:use-module (guix memoization) 23 #:use-module (guix memoization)
23 #:use-module (guix packages) 24 #:use-module (guix packages)
24 #:use-module (guix derivations) 25 #:use-module (guix gexp)
26 #:use-module (guix monads)
25 #:use-module (guix search-paths) 27 #:use-module (guix search-paths)
26 #:use-module (guix build-system) 28 #:use-module (guix build-system)
27 #:use-module (guix build-system gnu) 29 #:use-module (guix build-system gnu)
@@ -53,7 +55,7 @@
53 #:rest arguments) 55 #:rest arguments)
54 "Return a bag for NAME." 56 "Return a bag for NAME."
55 (define private-keywords 57 (define private-keywords
56 '(#:source #:target #:renpy #:inputs #:native-inputs)) 58 '(#:target #:renpy #:inputs #:native-inputs))
57 59
58 (and (not target) ;XXX: no cross-compilation 60 (and (not target) ;XXX: no cross-compilation
59 (bag 61 (bag
@@ -72,57 +74,43 @@
72 (build renpy-build) 74 (build renpy-build)
73 (arguments (strip-keyword-arguments private-keywords arguments))))) 75 (arguments (strip-keyword-arguments private-keywords arguments)))))
74 76
75(define* (renpy-build store name inputs 77(define* (renpy-build name inputs
76 #:key 78 #:key
77 (phases '(@ (guix build renpy-build-system) 79 source
78 %standard-phases)) 80 (phases '(@ (guix build renpy-build-system)
79 (configure-flags ''()) 81 %standard-phases))
80 (outputs '("out")) 82 (configure-flags ''())
81 (output "out") 83 (outputs '("out"))
82 (game "game") 84 (output "out")
83 (search-paths '()) 85 (game "game")
84 (system (%current-system)) 86 (search-paths '())
85 (guile #f) 87 (system (%current-system))
86 (imported-modules %renpy-build-system-modules) 88 (guile #f)
87 (modules '((guix build renpy-build-system) 89 (imported-modules %renpy-build-system-modules)
88 (guix build utils)))) 90 (modules '((guix build renpy-build-system)
91 (guix build utils))))
89 "Build SOURCE using RENPY, and with INPUTS." 92 "Build SOURCE using RENPY, and with INPUTS."
90 (define builder 93 (define builder
91 `(begin 94 (with-imported-modules imported-modules
92 (use-modules ,@modules) 95 #~(begin
93 (renpy-build #:name ,name 96 (use-modules #$@modules)
94 #:source ,(match (assoc-ref inputs "source") 97 (renpy-build #:name #$name
95 (((? derivation? source)) 98 #:source #+source
96 (derivation->output-path source)) 99 #:configure-flags #$configure-flags
97 ((source) 100 #:system #$system
98 source) 101 #:phases #$phases
99 (source 102 #:outputs #$(outputs->gexp outputs)
100 source)) 103 #:output #$output
101 #:configure-flags ,configure-flags 104 #:game #$game
102 #:system ,system 105 #:search-paths '#$(map search-path-specification->sexp
103 #:phases ,phases 106 search-paths)
104 #:outputs %outputs 107 #:inputs #$(input-tuples->gexp inputs)))))
105 #:output ,output
106 #:game ,game
107 #:search-paths ',(map search-path-specification->sexp
108 search-paths)
109 #:inputs %build-inputs)))
110 108
111 (define guile-for-build 109 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
112 (match guile 110 system #:graft? #f)))
113 ((? package?) 111 (gexp->derivation name builder
114 (package-derivation store guile system #:graft? #f)) 112 #:system system
115 (#f ; the default 113 #:guile-for-build guile)))
116 (let* ((distro (resolve-interface '(gnu packages commencement)))
117 (guile (module-ref distro 'guile-final)))
118 (package-derivation store guile system #:graft? #f)))))
119
120 (build-expression->derivation store name builder
121 #:inputs inputs
122 #:system system
123 #:modules imported-modules
124 #:outputs outputs
125 #:guile-for-build guile-for-build))
126 114
127(define renpy-build-system 115(define renpy-build-system
128 (build-system 116 (build-system
diff --git a/guix/build-system/ruby.scm b/guix/build-system/ruby.scm
index 8142e8551ab..8b02e0ff526 100644
--- a/guix/build-system/ruby.scm
+++ b/guix/build-system/ruby.scm
@@ -1,6 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2014 David Thompson <davet@gnu.org> 2;;; Copyright © 2014 David Thompson <davet@gnu.org>
3;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> 3;;; Copyright © 2014, 2015, 2021 Ludovic Courtès <ludo@gnu.org>
4;;; 4;;;
5;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
6;;; 6;;;
@@ -20,6 +20,8 @@
20(define-module (guix build-system ruby) 20(define-module (guix build-system ruby)
21 #:use-module (guix store) 21 #:use-module (guix store)
22 #:use-module (guix utils) 22 #:use-module (guix utils)
23 #:use-module (guix gexp)
24 #:use-module (guix monads)
23 #:use-module (guix packages) 25 #:use-module (guix packages)
24 #:use-module (guix derivations) 26 #:use-module (guix derivations)
25 #:use-module (guix search-paths) 27 #:use-module (guix search-paths)
@@ -54,7 +56,7 @@ NAME and VERSION."
54 #:rest arguments) 56 #:rest arguments)
55 "Return a bag for NAME." 57 "Return a bag for NAME."
56 (define private-keywords 58 (define private-keywords
57 '(#:source #:target #:ruby #:inputs #:native-inputs)) 59 '(#:target #:ruby #:inputs #:native-inputs))
58 60
59 (and (not target) ;XXX: no cross-compilation 61 (and (not target) ;XXX: no cross-compilation
60 (bag 62 (bag
@@ -73,8 +75,8 @@ NAME and VERSION."
73 (build ruby-build) 75 (build ruby-build)
74 (arguments (strip-keyword-arguments private-keywords arguments))))) 76 (arguments (strip-keyword-arguments private-keywords arguments)))))
75 77
76(define* (ruby-build store name inputs 78(define* (ruby-build name inputs
77 #:key 79 #:key source
78 (gem-flags ''()) 80 (gem-flags ''())
79 (test-target "test") 81 (test-target "test")
80 (tests? #t) 82 (tests? #t)
@@ -88,42 +90,30 @@ NAME and VERSION."
88 (modules '((guix build ruby-build-system) 90 (modules '((guix build ruby-build-system)
89 (guix build utils)))) 91 (guix build utils))))
90 "Build SOURCE using RUBY and INPUTS." 92 "Build SOURCE using RUBY and INPUTS."
91 (define builder 93 (define build
92 `(begin 94 #~(begin
93 (use-modules ,@modules) 95 (use-modules #$@modules)
94 (ruby-build #:name ,name
95 #:source ,(match (assoc-ref inputs "source")
96 (((? derivation? source))
97 (derivation->output-path source))
98 ((source)
99 source)
100 (source
101 source))
102 #:system ,system
103 #:gem-flags ,gem-flags
104 #:test-target ,test-target
105 #:tests? ,tests?
106 #:phases ,phases
107 #:outputs %outputs
108 #:search-paths ',(map search-path-specification->sexp
109 search-paths)
110 #:inputs %build-inputs)))
111 96
112 (define guile-for-build 97 #$(with-build-variables inputs outputs
113 (match guile 98 #~(ruby-build #:name #$name
114 ((? package?) 99 #:source #+source
115 (package-derivation store guile system #:graft? #f)) 100 #:system #$system
116 (#f 101 #:gem-flags #$gem-flags
117 (let* ((distro (resolve-interface '(gnu packages commencement))) 102 #:test-target #$test-target
118 (guile (module-ref distro 'guile-final))) 103 #:tests? #$tests?
119 (package-derivation store guile system #:graft? #f))))) 104 #:phases #$phases
105 #:outputs %outputs
106 #:search-paths '#$(map search-path-specification->sexp
107 search-paths)
108 #:inputs %build-inputs))))
120 109
121 (build-expression->derivation store name builder 110 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
122 #:inputs inputs 111 system #:graft? #f)))
123 #:system system 112 (gexp->derivation name build
124 #:modules imported-modules 113 #:system system
125 #:outputs outputs 114 #:target #f
126 #:guile-for-build guile-for-build)) 115 #:modules imported-modules
116 #:guile-for-build guile)))
127 117
128(define ruby-build-system 118(define ruby-build-system
129 (build-system 119 (build-system
diff --git a/guix/build-system/scons.scm b/guix/build-system/scons.scm
index aad455c419a..6af6998d261 100644
--- a/guix/build-system/scons.scm
+++ b/guix/build-system/scons.scm
@@ -1,5 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net> 2;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
3;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
3;;; 4;;;
4;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
5;;; 6;;;
@@ -19,7 +20,8 @@
19(define-module (guix build-system scons) 20(define-module (guix build-system scons)
20 #:use-module (guix utils) 21 #:use-module (guix utils)
21 #:use-module (guix packages) 22 #:use-module (guix packages)
22 #:use-module (guix derivations) 23 #:use-module (guix monads)
24 #:use-module (guix gexp)
23 #:use-module (guix search-paths) 25 #:use-module (guix search-paths)
24 #:use-module (guix build-system) 26 #:use-module (guix build-system)
25 #:use-module (guix build-system gnu) 27 #:use-module (guix build-system gnu)
@@ -53,7 +55,7 @@
53 #:rest arguments) 55 #:rest arguments)
54 "Return a bag for NAME." 56 "Return a bag for NAME."
55 (define private-keywords 57 (define private-keywords
56 '(#:source #:target #:scons #:inputs #:native-inputs)) 58 '(#:target #:scons #:inputs #:native-inputs))
57 59
58 (and (not target) ;XXX: no cross-compilation 60 (and (not target) ;XXX: no cross-compilation
59 (bag 61 (bag
@@ -72,8 +74,9 @@
72 (build scons-build) 74 (build scons-build)
73 (arguments (strip-keyword-arguments private-keywords arguments))))) 75 (arguments (strip-keyword-arguments private-keywords arguments)))))
74 76
75(define* (scons-build store name inputs 77(define* (scons-build name inputs
76 #:key 78 #:key
79 (source #f)
77 (tests? #t) 80 (tests? #t)
78 (scons-flags ''()) 81 (scons-flags ''())
79 (build-targets ''()) 82 (build-targets ''())
@@ -91,43 +94,33 @@
91 "Build SOURCE using SCons, and with INPUTS. This assumes that SOURCE 94 "Build SOURCE using SCons, and with INPUTS. This assumes that SOURCE
92provides a 'SConstruct' file as its build system." 95provides a 'SConstruct' file as its build system."
93 (define builder 96 (define builder
94 `(begin 97 (with-imported-modules imported-modules
95 (use-modules ,@modules) 98 #~(begin
96 (scons-build #:name ,name 99 (use-modules #$@modules)
97 #:source ,(match (assoc-ref inputs "source")
98 (((? derivation? source))
99 (derivation->output-path source))
100 ((source)
101 source)
102 (source
103 source))
104 #:scons-flags ,scons-flags
105 #:system ,system
106 #:build-targets ,build-targets
107 #:test-target ,test-target
108 #:tests? ,tests?
109 #:install-targets ,install-targets
110 #:phases ,phases
111 #:outputs %outputs
112 #:search-paths ',(map search-path-specification->sexp
113 search-paths)
114 #:inputs %build-inputs)))
115 100
116 (define guile-for-build 101 (scons-build #:name ,name
117 (match guile 102 #:source #+source
118 ((? package?) 103 #:scons-flags #$scons-flags
119 (package-derivation store guile system #:graft? #f)) 104 #:system #$system
120 (#f ; the default 105 #:build-targets #$build-targets
121 (let* ((distro (resolve-interface '(gnu packages commencement))) 106 #:test-target #$test-target
122 (guile (module-ref distro 'guile-final))) 107 #:tests? #$tests?
123 (package-derivation store guile system #:graft? #f))))) 108 #:install-targets #$install-targets
109 #:phases #$phases
110 #:outputs (list #$@(map (lambda (name)
111 #~(cons #$name
112 (ungexp output name)))
113 outputs))
114 #:inputs (map (lambda (tuple)
115 (apply cons tuple))
116 '#$inputs)
117 #:search-paths '#$(map search-path-specification->sexp
118 search-paths)))))
124 119
125 (build-expression->derivation store name builder 120 (gexp->derivation name builder
126 #:inputs inputs 121 #:system system
127 #:system system 122 #:target #f
128 #:modules imported-modules 123 #:guile-for-build guile))
129 #:outputs outputs
130 #:guile-for-build guile-for-build))
131 124
132(define scons-build-system 125(define scons-build-system
133 (build-system 126 (build-system
diff --git a/guix/build-system/texlive.scm b/guix/build-system/texlive.scm
index a8545757be5..0a69d1f3287 100644
--- a/guix/build-system/texlive.scm
+++ b/guix/build-system/texlive.scm
@@ -1,5 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> 2;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
3;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
3;;; 4;;;
4;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
5;;; 6;;;
@@ -20,7 +21,8 @@
20 #:use-module (guix store) 21 #:use-module (guix store)
21 #:use-module (guix utils) 22 #:use-module (guix utils)
22 #:use-module (guix packages) 23 #:use-module (guix packages)
23 #:use-module (guix derivations) 24 #:use-module (guix monads)
25 #:use-module (guix gexp)
24 #:use-module (guix search-paths) 26 #:use-module (guix search-paths)
25 #:use-module (guix build-system) 27 #:use-module (guix build-system)
26 #:use-module (guix build-system gnu) 28 #:use-module (guix build-system gnu)
@@ -100,7 +102,7 @@ level package ID."
100 #:rest arguments) 102 #:rest arguments)
101 "Return a bag for NAME." 103 "Return a bag for NAME."
102 (define private-keywords 104 (define private-keywords
103 '(#:source #:target #:inputs #:native-inputs 105 '(#:target #:inputs #:native-inputs
104 #:texlive-latex-base #:texlive-bin)) 106 #:texlive-latex-base #:texlive-bin))
105 107
106 (bag 108 (bag
@@ -120,8 +122,9 @@ level package ID."
120 (build texlive-build) 122 (build texlive-build)
121 (arguments (strip-keyword-arguments private-keywords arguments)))) 123 (arguments (strip-keyword-arguments private-keywords arguments))))
122 124
123(define* (texlive-build store name inputs 125(define* (texlive-build name inputs
124 #:key 126 #:key
127 source
125 (tests? #f) 128 (tests? #f)
126 tex-directory 129 tex-directory
127 (build-targets #f) 130 (build-targets #f)
@@ -139,43 +142,31 @@ level package ID."
139 (guix build utils)))) 142 (guix build utils))))
140 "Build SOURCE with INPUTS." 143 "Build SOURCE with INPUTS."
141 (define builder 144 (define builder
142 `(begin 145 (with-imported-modules imported-modules
143 (use-modules ,@modules) 146 #~(begin
144 (texlive-build #:name ,name 147 (use-modules #$@modules)
145 #:source ,(match (assoc-ref inputs "source") 148 (texlive-build #:name #$name
146 (((? derivation? source)) 149 #:source #+source
147 (derivation->output-path source)) 150 #:tex-directory #$tex-directory
148 ((source) 151 #:build-targets #$build-targets
149 source) 152 #:tex-format #$tex-format
150 (source 153 #:system #$system
151 source)) 154 #:tests? #$tests?
152 #:tex-directory ,tex-directory 155 #:phases #$phases
153 #:build-targets ,build-targets 156 #:outputs (list #$@(map (lambda (name)
154 #:tex-format ,tex-format 157 #~(cons #$name
155 #:system ,system 158 (ungexp output name)))
156 #:tests? ,tests? 159 outputs))
157 #:phases ,phases 160 #:inputs (map (lambda (tuple)
158 #:outputs %outputs 161 (apply cons tuple))
159 #:search-paths ',(map search-path-specification->sexp 162 '#$inputs)
160 search-paths) 163 #:search-paths '#$(map search-path-specification->sexp
161 #:inputs %build-inputs))) 164 search-paths)))))
162 165
163 (define guile-for-build 166 (gexp->derivation name builder
164 (match guile 167 #:system system
165 ((? package?) 168 #:target #f
166 (package-derivation store guile system #:graft? #f)) 169 #:substitutable? substitutable?))
167 (#f ; the default
168 (let* ((distro (resolve-interface '(gnu packages commencement)))
169 (guile (module-ref distro 'guile-final)))
170 (package-derivation store guile system #:graft? #f)))))
171
172 (build-expression->derivation store name builder
173 #:inputs inputs
174 #:system system
175 #:modules imported-modules
176 #:outputs outputs
177 #:guile-for-build guile-for-build
178 #:substitutable? substitutable?))
179 170
180(define texlive-build-system 171(define texlive-build-system
181 (build-system 172 (build-system
diff --git a/guix/build-system/trivial.scm b/guix/build-system/trivial.scm
index b50ef7cd92e..0f895242313 100644
--- a/guix/build-system/trivial.scm
+++ b/guix/build-system/trivial.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2012, 2013, 2014, 2018 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2012, 2013, 2014, 2015, 2018, 2021 Ludovic Courtès <ludo@gnu.org>
3;;; 3;;;
4;;; This file is part of GNU Guix. 4;;; This file is part of GNU Guix.
5;;; 5;;;
@@ -19,24 +19,16 @@
19(define-module (guix build-system trivial) 19(define-module (guix build-system trivial)
20 #:use-module (guix store) 20 #:use-module (guix store)
21 #:use-module (guix utils) 21 #:use-module (guix utils)
22 #:use-module (guix derivations) 22 #:use-module (guix gexp)
23 #:use-module (guix monads)
23 #:use-module (guix packages) 24 #:use-module (guix packages)
24 #:use-module (guix build-system) 25 #:use-module (guix build-system)
25 #:use-module (ice-9 match) 26 #:use-module (ice-9 match)
26 #:export (trivial-build-system)) 27 #:export (trivial-build-system))
27 28
28(define (guile-for-build store guile system)
29 (match guile
30 ((? package?)
31 (package-derivation store guile system #:graft? #f))
32 (#f ; the default
33 (let* ((distro (resolve-interface '(gnu packages commencement)))
34 (guile (module-ref distro 'guile-final)))
35 (package-derivation store guile system #:graft? #f)))))
36
37(define* (lower name 29(define* (lower name
38 #:key source inputs native-inputs outputs system target 30 #:key source inputs native-inputs outputs system target
39 guile builder modules allowed-references) 31 guile builder (modules '()) allowed-references)
40 "Return a bag for NAME." 32 "Return a bag for NAME."
41 (bag 33 (bag
42 (name name) 34 (name name)
@@ -54,65 +46,42 @@
54 #:modules ,modules 46 #:modules ,modules
55 #:allowed-references ,allowed-references)))) 47 #:allowed-references ,allowed-references))))
56 48
57(define* (trivial-build store name inputs 49(define* (trivial-build name inputs
58 #:key 50 #:key
59 outputs guile system builder (modules '()) 51 outputs guile
52 system builder (modules '())
60 search-paths allowed-references) 53 search-paths allowed-references)
61 "Run build expression BUILDER, an expression, for SYSTEM. SOURCE is 54 "Run build expression BUILDER, an expression, for SYSTEM. SOURCE is
62ignored." 55ignored."
63 (define canonicalize-reference 56 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
64 (match-lambda 57 system #:graft? #f)))
65 ((? package? p) 58 (gexp->derivation name (with-build-variables inputs outputs builder)
66 (derivation->output-path (package-derivation store p system 59 #:system system
67 #:graft? #f))) 60 #:target #f
68 (((? package? p) output) 61 #:modules modules
69 (derivation->output-path (package-derivation store p system 62 #:allowed-references allowed-references
70 #:graft? #f) 63 #:guile-for-build guile)))
71 output))
72 ((? string? output)
73 output)))
74
75 (build-expression->derivation store name builder
76 #:inputs inputs
77 #:system system
78 #:outputs outputs
79 #:modules modules
80 #:allowed-references
81 (and allowed-references
82 (map canonicalize-reference
83 allowed-references))
84 #:guile-for-build
85 (guile-for-build store guile system)))
86 64
87(define* (trivial-cross-build store name 65(define* (trivial-cross-build name
88 #:key 66 #:key
89 target native-drvs target-drvs 67 target
68 source build-inputs target-inputs host-inputs
90 outputs guile system builder (modules '()) 69 outputs guile system builder (modules '())
91 search-paths native-search-paths 70 search-paths native-search-paths
92 allowed-references) 71 allowed-references)
93 "Run build expression BUILDER, an expression, for SYSTEM. SOURCE is 72 "Run build expression BUILDER, an expression, for SYSTEM. SOURCE is
94ignored." 73ignored."
95 (define canonicalize-reference 74 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
96 (match-lambda 75 system #:graft? #f)))
97 ((? package? p) 76 (gexp->derivation name (with-build-variables
98 (derivation->output-path (package-cross-derivation store p system))) 77 (append build-inputs target-inputs)
99 (((? package? p) output) 78 outputs
100 (derivation->output-path (package-cross-derivation store p system) 79 builder)
101 output)) 80 #:system system
102 ((? string? output) 81 #:target target
103 output))) 82 #:modules modules
104 83 #:allowed-references allowed-references
105 (build-expression->derivation store name builder 84 #:guile-for-build guile)))
106 #:inputs (append native-drvs target-drvs)
107 #:system system
108 #:outputs outputs
109 #:modules modules
110 #:allowed-references
111 (and allowed-references
112 (map canonicalize-reference
113 allowed-references))
114 #:guile-for-build
115 (guile-for-build store guile system)))
116 85
117(define trivial-build-system 86(define trivial-build-system
118 (build-system 87 (build-system
diff --git a/guix/build-system/waf.scm b/guix/build-system/waf.scm
index 044d2a08299..db604e6ecfb 100644
--- a/guix/build-system/waf.scm
+++ b/guix/build-system/waf.scm
@@ -19,6 +19,8 @@
19(define-module (guix build-system waf) 19(define-module (guix build-system waf)
20 #:use-module (guix store) 20 #:use-module (guix store)
21 #:use-module (guix utils) 21 #:use-module (guix utils)
22 #:use-module (guix gexp)
23 #:use-module (guix monads)
22 #:use-module (guix packages) 24 #:use-module (guix packages)
23 #:use-module (guix derivations) 25 #:use-module (guix derivations)
24 #:use-module (guix search-paths) 26 #:use-module (guix search-paths)
@@ -52,7 +54,7 @@
52 #:rest arguments) 54 #:rest arguments)
53 "Return a bag for NAME." 55 "Return a bag for NAME."
54 (define private-keywords 56 (define private-keywords
55 '(#:source #:target #:python #:inputs #:native-inputs)) 57 '(#:target #:python #:inputs #:native-inputs))
56 58
57 (and (not target) ;XXX: no cross-compilation 59 (and (not target) ;XXX: no cross-compilation
58 (bag 60 (bag
@@ -71,58 +73,46 @@
71 (build waf-build) ; only change compared to 'lower' in python.scm 73 (build waf-build) ; only change compared to 'lower' in python.scm
72 (arguments (strip-keyword-arguments private-keywords arguments))))) 74 (arguments (strip-keyword-arguments private-keywords arguments)))))
73 75
74(define* (waf-build store name inputs 76(define* (waf-build name inputs
75 #:key 77 #:key source
76 (tests? #t) 78 (tests? #t)
77 (test-target "check") 79 (test-target "check")
78 (configure-flags ''()) 80 (configure-flags ''())
79 (phases '(@ (guix build waf-build-system) 81 (phases '(@ (guix build waf-build-system)
80 %standard-phases)) 82 %standard-phases))
81 (outputs '("out")) 83 (outputs '("out"))
82 (search-paths '()) 84 (search-paths '())
83 (system (%current-system)) 85 (system (%current-system))
84 (guile #f) 86 (guile #f)
85 (imported-modules %waf-build-system-modules) 87 (imported-modules %waf-build-system-modules)
86 (modules '((guix build waf-build-system) 88 (modules '((guix build waf-build-system)
87 (guix build utils)))) 89 (guix build utils))))
88 "Build SOURCE with INPUTS. This assumes that SOURCE provides a 'waf' file 90 "Build SOURCE with INPUTS. This assumes that SOURCE provides a 'waf' file
89as its build system." 91as its build system."
90 (define builder 92 (define build
91 `(begin 93 #~(begin
92 (use-modules ,@modules) 94 (use-modules #$@modules)
93 (waf-build #:name ,name
94 #:source ,(match (assoc-ref inputs "source")
95 (((? derivation? source))
96 (derivation->output-path source))
97 ((source)
98 source)
99 (source
100 source))
101 #:configure-flags ,configure-flags
102 #:system ,system
103 #:test-target ,test-target
104 #:tests? ,tests?
105 #:phases ,phases
106 #:outputs %outputs
107 #:search-paths ',(map search-path-specification->sexp
108 search-paths)
109 #:inputs %build-inputs)))
110 95
111 (define guile-for-build 96 #$(with-build-variables inputs outputs
112 (match guile 97 #~(waf-build #:name #$name
113 ((? package?) 98 #:source #+source
114 (package-derivation store guile system #:graft? #f)) 99 #:configure-flags #$configure-flags
115 (#f ; the default 100 #:system #$system
116 (let* ((distro (resolve-interface '(gnu packages commencement))) 101 #:test-target #$test-target
117 (guile (module-ref distro 'guile-final))) 102 #:tests? #$tests?
118 (package-derivation store guile system #:graft? #f))))) 103 #:phases #$phases
104 #:outputs %outputs
105 #:search-paths '#$(map search-path-specification->sexp
106 search-paths)
107 #:inputs %build-inputs))))
119 108
120 (build-expression->derivation store name builder 109 (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
121 #:inputs inputs 110 system #:graft? #f)))
122 #:system system 111 (gexp->derivation name build
123 #:modules imported-modules 112 #:system system
124 #:outputs outputs 113 #:target #f
125 #:guile-for-build guile-for-build)) 114 #:modules imported-modules
115 #:guile-for-build guile)))
126 116
127(define waf-build-system 117(define waf-build-system
128 (build-system 118 (build-system
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 3817bdd855e..a4e6590b529 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -112,6 +112,7 @@
112 mixed-text-file 112 mixed-text-file
113 file-union 113 file-union
114 directory-union 114 directory-union
115
115 imported-files 116 imported-files
116 imported-modules 117 imported-modules
117 compiled-modules 118 compiled-modules
diff --git a/guix/packages.scm b/guix/packages.scm
index 56173e12044..6dc652fe7af 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1174,10 +1174,6 @@ matching package and returns a replacement for that package."
1174;;; Package derivations. 1174;;; Package derivations.
1175;;; 1175;;;
1176 1176
1177(define %derivation-cache
1178 ;; Package to derivation-path mapping.
1179 (make-weak-key-hash-table 100))
1180
1181(define (cache! cache package system thunk) 1177(define (cache! cache package system thunk)
1182 "Memoize in CACHE the return values of THUNK as the derivation of PACKAGE on 1178 "Memoize in CACHE the return values of THUNK as the derivation of PACKAGE on
1183SYSTEM." 1179SYSTEM."
@@ -1209,48 +1205,29 @@ Return the cached result when available."
1209 ((_ package system body ...) 1205 ((_ package system body ...)
1210 (cached (=> %derivation-cache) package system body ...)))) 1206 (cached (=> %derivation-cache) package system body ...))))
1211 1207
1212(define* (expand-input store package input system #:optional cross-system) 1208(define* (expand-input package input #:key native?)
1213 "Expand INPUT, an input tuple, such that it contains only references to 1209 "Expand INPUT, an input tuple, to a name/<gexp-input> tuple. PACKAGE is
1214derivation paths or store paths. PACKAGE is only used to provide contextual 1210only used to provide contextual information in exceptions."
1215information in exceptions." 1211 (define (valid? x)
1216 (define (intern file) 1212 (or (package? x) (origin? x) (derivation? x)))
1217 ;; Add FILE to the store. Set the `recursive?' bit to #t, so that
1218 ;; file permissions are preserved.
1219 (add-to-store store (basename file) #t "sha256" file))
1220
1221 (define derivation
1222 (if cross-system
1223 (cut package-cross-derivation store <> cross-system system
1224 #:graft? #f)
1225 (cut package-derivation store <> system #:graft? #f)))
1226 1213
1227 (match input 1214 (match input
1228 (((? string? name) (? package? package)) 1215 (((? string? name) (? valid? thing))
1229 (list name (derivation package))) 1216 (list name (gexp-input thing #:native? native?)))
1230 (((? string? name) (? package? package) 1217 (((? string? name) (? valid? thing) (? string? output))
1231 (? string? sub-drv)) 1218 (list name (gexp-input thing output #:native? native?)))
1232 (list name (derivation package)
1233 sub-drv))
1234 (((? string? name)
1235 (and (? string?) (? derivation-path?) drv))
1236 (list name drv))
1237 (((? string? name) 1219 (((? string? name)
1238 (and (? string?) (? file-exists? file))) 1220 (and (? string?) (? file-exists? file)))
1239 ;; Add FILE to the store. When FILE is in the sub-directory of a 1221 ;; Add FILE to the store. When FILE is in the sub-directory of a
1240 ;; store path, it needs to be added anyway, so it can be used as a 1222 ;; store path, it needs to be added anyway, so it can be used as a
1241 ;; source. 1223 ;; source.
1242 (list name (intern file))) 1224 (list name (gexp-input (local-file file #:recursive? #t)
1225 #:native? native?)))
1243 (((? string? name) (? struct? source)) 1226 (((? string? name) (? struct? source))
1244 ;; 'package-source-derivation' calls 'lower-object', which can throw 1227 ;; 'package-source-derivation' calls 'lower-object', which can throw
1245 ;; '&gexp-input-error'. However '&gexp-input-error' lacks source 1228 ;; '&gexp-input-error'. However '&gexp-input-error' lacks source
1246 ;; location info, so we catch and rethrow here (XXX: not optimal 1229 ;; location info, so we used to catch and rethrow here (FIXME!).
1247 ;; performance-wise). 1230 (list name (gexp-input source)))
1248 (guard (c ((gexp-input-error? c)
1249 (raise (condition
1250 (&package-input-error
1251 (package package)
1252 (input (gexp-error-invalid-input c)))))))
1253 (list name (package-source-derivation store source system))))
1254 (x 1231 (x
1255 (raise (condition (&package-input-error 1232 (raise (condition (&package-input-error
1256 (package package) 1233 (package package)
@@ -1434,12 +1411,14 @@ TARGET."
1434(define (input=? input1 input2) 1411(define (input=? input1 input2)
1435 "Return true if INPUT1 and INPUT2 are equivalent." 1412 "Return true if INPUT1 and INPUT2 are equivalent."
1436 (match input1 1413 (match input1
1437 ((label1 drv1 . outputs1) 1414 ((label1 obj1 . outputs1)
1438 (match input2 1415 (match input2
1439 ((label2 drv2 . outputs2) 1416 ((label2 obj2 . outputs2)
1440 (and (string=? label1 label2) 1417 (and (string=? label1 label2)
1441 (equal? outputs1 outputs2) 1418 (equal? outputs1 outputs2)
1442 (derivation=? drv1 drv2))))))) 1419 (or (and (derivation? obj1) (derivation? obj2)
1420 (derivation=? obj1 obj2))
1421 (equal? obj1 obj2))))))))
1443 1422
1444(define* (bag->derivation store bag 1423(define* (bag->derivation store bag
1445 #:optional context) 1424 #:optional context)
@@ -1450,7 +1429,7 @@ error reporting."
1450 (bag->cross-derivation store bag) 1429 (bag->cross-derivation store bag)
1451 (let* ((system (bag-system bag)) 1430 (let* ((system (bag-system bag))
1452 (inputs (bag-transitive-inputs bag)) 1431 (inputs (bag-transitive-inputs bag))
1453 (input-drvs (map (cut expand-input store context <> system) 1432 (input-drvs (map (cut expand-input context <> #:native? #t)
1454 inputs)) 1433 inputs))
1455 (paths (delete-duplicates 1434 (paths (delete-duplicates
1456 (append-map (match-lambda 1435 (append-map (match-lambda
@@ -1462,7 +1441,8 @@ error reporting."
1462 ;; It's possible that INPUTS contains packages that are not 'eq?' but 1441 ;; It's possible that INPUTS contains packages that are not 'eq?' but
1463 ;; that lead to the same derivation. Delete those duplicates to avoid 1442 ;; that lead to the same derivation. Delete those duplicates to avoid
1464 ;; issues down the road, such as duplicate entries in '%build-inputs'. 1443 ;; issues down the road, such as duplicate entries in '%build-inputs'.
1465 (apply (bag-build bag) 1444 ;; TODO: Change to monadic style.
1445 (apply (store-lower (bag-build bag))
1466 store (bag-name bag) 1446 store (bag-name bag)
1467 (delete-duplicates input-drvs input=?) 1447 (delete-duplicates input-drvs input=?)
1468 #:search-paths paths 1448 #:search-paths paths
@@ -1477,13 +1457,13 @@ This is an internal procedure."
1477 (let* ((system (bag-system bag)) 1457 (let* ((system (bag-system bag))
1478 (target (bag-target bag)) 1458 (target (bag-target bag))
1479 (host (bag-transitive-host-inputs bag)) 1459 (host (bag-transitive-host-inputs bag))
1480 (host-drvs (map (cut expand-input store context <> system target) 1460 (host-drvs (map (cut expand-input context <> #:native? #f)
1481 host)) 1461 host))
1482 (target* (bag-transitive-target-inputs bag)) 1462 (target* (bag-transitive-target-inputs bag))
1483 (target-drvs (map (cut expand-input store context <> system) 1463 (target-drvs (map (cut expand-input context <> #:native? #t)
1484 target*)) 1464 target*))
1485 (build (bag-transitive-build-inputs bag)) 1465 (build (bag-transitive-build-inputs bag))
1486 (build-drvs (map (cut expand-input store context <> system) 1466 (build-drvs (map (cut expand-input context <> #:native? #t)
1487 build)) 1467 build))
1488 (all (append build target* host)) 1468 (all (append build target* host))
1489 (paths (delete-duplicates 1469 (paths (delete-duplicates
@@ -1500,11 +1480,12 @@ This is an internal procedure."
1500 (_ '())) 1480 (_ '()))
1501 all)))) 1481 all))))
1502 1482
1503 (apply (bag-build bag) 1483 ;; TODO: Change to monadic style.
1484 (apply (store-lower (bag-build bag))
1504 store (bag-name bag) 1485 store (bag-name bag)
1505 #:native-drvs (delete-duplicates build-drvs input=?) 1486 #:build-inputs (delete-duplicates build-drvs input=?)
1506 #:target-drvs (delete-duplicates (append host-drvs target-drvs) 1487 #:host-inputs (delete-duplicates host-drvs input=?)
1507 input=?) 1488 #:target-inputs (delete-duplicates target-drvs input=?)
1508 #:search-paths paths 1489 #:search-paths paths
1509 #:native-search-paths npaths 1490 #:native-search-paths npaths
1510 #:outputs (bag-outputs bag) 1491 #:outputs (bag-outputs bag)
diff --git a/tests/builders.scm b/tests/builders.scm
index 2143c0738b8..f36a8c9f59e 100644
--- a/tests/builders.scm
+++ b/tests/builders.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2012, 2013, 2014, 2015, 2019 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2012, 2013, 2014, 2015, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2021 Lars-Dominik Braun <lars@6xq.net> 3;;; Copyright © 2021 Lars-Dominik Braun <lars@6xq.net>
4;;; 4;;;
5;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
diff --git a/tests/lint.scm b/tests/lint.scm
index bd8604f589c..47d5701b7dd 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -1,7 +1,7 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com> 2;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
3;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org> 3;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org>
4;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> 4;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
5;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org> 5;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
6;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com> 6;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
7;;; Copyright © 2017 Alex Kost <alezost@gmail.com> 7;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
@@ -432,7 +432,7 @@
432 (single-lint-warning-message (check-patch-headers pkg))))) 432 (single-lint-warning-message (check-patch-headers pkg)))))
433 433
434(test-equal "derivation: invalid arguments" 434(test-equal "derivation: invalid arguments"
435 "failed to create x86_64-linux derivation: (wrong-type-arg \"map\" \"Wrong type argument: ~S\" (invalid-module) ())" 435 "failed to create x86_64-linux derivation: (match-error \"match\" \"no matching pattern\" invalid-module)"
436 (match (let ((pkg (dummy-package "x" 436 (match (let ((pkg (dummy-package "x"
437 (arguments 437 (arguments
438 '(#:imported-modules (invalid-module)))))) 438 '(#:imported-modules (invalid-module))))))
diff --git a/tests/packages.scm b/tests/packages.scm
index ff756c6001b..d1dab7d6a58 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -868,9 +868,9 @@
868 (system system) (target target) 868 (system system) (target target)
869 (build-inputs inputs) 869 (build-inputs inputs)
870 (build 870 (build
871 (lambda* (store name inputs 871 (lambda* (name inputs
872 #:key outputs system search-paths) 872 #:key outputs system search-paths)
873 search-paths))))))) 873 (abort-to-prompt p search-paths))))))))
874 (x (list (search-path-specification 874 (x (list (search-path-specification
875 (variable "GUILE_LOAD_PATH") 875 (variable "GUILE_LOAD_PATH")
876 (files '("share/guile/site/2.0"))) 876 (files '("share/guile/site/2.0")))
@@ -1170,11 +1170,11 @@
1170 (bag (name name) (system system) (target target) 1170 (bag (name name) (system system) (target target)
1171 (build-inputs native-inputs) 1171 (build-inputs native-inputs)
1172 (host-inputs inputs) 1172 (host-inputs inputs)
1173 (build (lambda* (store name inputs 1173 (build (lambda* (name inputs
1174 #:key system target 1174 #:key system target
1175 #:allow-other-keys) 1175 #:allow-other-keys)
1176 (build-expression->derivation 1176 (gexp->derivation "foo"
1177 store "foo" '(mkdir %output)))))))) 1177 #~(mkdir #$output))))))))
1178 (bs (build-system 1178 (bs (build-system
1179 (name 'build-system-without-cross-compilation) 1179 (name 'build-system-without-cross-compilation)
1180 (description "Does not support cross compilation.") 1180 (description "Does not support cross compilation.")
generated by cgit v1.2.3 (git 2.25.1) at 2026-09-03 08:12:21 +0000