diff options
Diffstat (limited to 'guix/build-system/meson.scm')
-rw-r--r-- | guix/build-system/meson.scm | 335 |
1 files changed, 241 insertions, 94 deletions
diff --git a/guix/build-system/meson.scm b/guix/build-system/meson.scm index b68bcb80de..dae0abde94 100644 --- a/guix/build-system/meson.scm +++ b/guix/build-system/meson.scm @@ -1,6 +1,8 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com> ;;; Copyright © 2018, 2019 Marius Bakke <mbakke@fastmail.com> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,9 +20,10 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix build-system meson) - #:use-module (guix store) + #:use-module (guix gexp) #:use-module (guix utils) - #:use-module (guix derivations) + #:use-module (guix store) + #:use-module (guix monads) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -28,7 +31,8 @@ #:use-module (guix packages) #:use-module (ice-9 match) #:export (%meson-build-system-modules - meson-build-system)) + meson-build-system + make-cross-file)) ;; Commentary: ;; @@ -38,6 +42,68 @@ ;; ;; Code: +(define (make-machine-alist triplet) + "Make an association list describing what should go into +the ‘host_machine’ section of the cross file when cross-compiling +for TRIPLET." + `((system . ,(cond ((target-hurd? triplet) "gnu") + ((target-linux? triplet) "linux") + ((target-mingw? triplet) "windows") + (#t (error "meson: unknown operating system")))) + (cpu_family . ,(cond ((target-x86-32? triplet) "x86") + ((target-x86-64? triplet) "x86_64") + ((target-arm32? triplet) "arm") + ((target-aarch64? triplet) "aarch64") + ((target-powerpc? triplet) + (if (target-64bit? triplet) + "ppc64" + "ppc")) + (#t (error "meson: unknown architecture")))) + (cpu . ,(cond ((target-x86-32? triplet) ; i386, ..., i686 + (substring triplet 0 4)) + ((target-x86-64? triplet) "x86_64") + ((target-aarch64? triplet) "armv8-a") + ((target-arm32? triplet) "armv7") + ;; According to #mesonbuild on OFTC, there does not appear + ;; to be an official-ish list of CPU types recognised by + ;; Meson, the "cpu" field is not used by Meson itself and + ;; most software doesn't look at this field, except perhaps + ;; for selecting optimisations, so set it to something + ;; arbitrary. + (#t "strawberries"))) + (endian . ,(cond ((string-prefix? "powerpc64le-" triplet) "little") + ((string-prefix? "mips64el-" triplet) "little") + ((target-x86-32? triplet) "little") + ((target-x86-64? triplet) "little") + ;; At least in Guix. Aarch64 and 32-bit arm + ;; have a big-endian mode as well. + ((target-arm? triplet) "little") + (#t (error "meson: unknown architecture")))))) + +(define (make-binaries-alist triplet) + "Make an associatoin list describing what should go into +the ‘binaries’ section of the cross file when cross-compiling for +TRIPLET." + `((c . ,(cc-for-target triplet)) + (cpp . ,(cxx-for-target triplet)) + (pkgconfig . ,(pkg-config-for-target triplet)) + (objcopy . ,(string-append triplet "-objcopy")) + (ar . ,(string-append triplet "-ar")) + (ld . ,(string-append triplet "-ld")) + (strip . ,(string-append triplet "-strip")))) + +(define (make-cross-file triplet) + (computed-file "cross-file" + (with-imported-modules '((guix build meson-configuration)) + #~(begin + (use-modules (guix build meson-configuration)) + (call-with-output-file #$output + (lambda (port) + (write-section-header port "host_machine") + (write-assignments port '#$(make-machine-alist triplet)) + (write-section-header port "binaries") + (write-assignments port '#$(make-binaries-alist triplet)))))))) + (define %meson-build-system-modules ;; Build-side modules imported by default. `((guix build meson-build-system) @@ -55,7 +121,7 @@ "Return the default meson package." ;; Lazily resolve the binding to avoid a circular dependency. (let ((module (resolve-interface '(gnu packages build-tools)))) - (module-ref module 'meson-for-build))) + (module-ref module 'meson))) (define* (lower name #:key source inputs native-inputs outputs system target @@ -66,27 +132,38 @@ #:rest arguments) "Return a bag for NAME." (define private-keywords - `(#:source #:meson #:ninja #:inputs #:native-inputs #:outputs #:target)) - - (and (not target) ;; TODO: add support for cross-compilation. - (bag - (name name) - (system system) - (build-inputs `(("meson" ,meson) - ("ninja" ,ninja) - ,@native-inputs - ,@inputs - ;; Keep the standard inputs of 'gnu-build-system'. - ,@(standard-packages))) - (host-inputs (if source - `(("source" ,source)) - '())) - (outputs outputs) - (build meson-build) - (arguments (strip-keyword-arguments private-keywords arguments))))) - -(define* (meson-build store name inputs - #:key (guile #f) + `(#:meson #:ninja #:inputs #:native-inputs #:outputs + ,@(if target + '() + '(#:target)))) + + (bag + (name name) + (system system) (target target) + (build-inputs `(("meson" ,meson) + ("ninja" ,ninja) + ,@native-inputs + ,@(if target '() inputs) + ;; Keep the standard inputs of 'gnu-build-system'. + ,@(if target + (standard-cross-packages target 'host) + '()) + ,@(standard-packages))) + (host-inputs `(,@(if source + `(("source" ,source)) + '()) + ,@(if target inputs '()))) + ;; Keep the standard inputs of 'gnu-buid-system'. + (target-inputs (if target + (standard-cross-packages target 'target) + '())) + (outputs outputs) + (build (if target meson-cross-build meson-build)) + (arguments (strip-keyword-arguments private-keywords arguments)))) + +(define* (meson-build name inputs + #:key + guile source (outputs '("out")) (configure-flags ''()) (search-paths '()) @@ -104,8 +181,7 @@ "bin" "sbin")) (elf-directories ''("lib" "lib64" "libexec" "bin" "sbin")) - (phases '(@ (guix build meson-build-system) - %standard-phases)) + (phases '%standard-phases) (system (%current-system)) (imported-modules %meson-build-system-modules) (modules '((guix build meson-build-system) @@ -114,76 +190,147 @@ disallowed-references) "Build SOURCE using MESON, and with INPUTS, assuming that SOURCE has a 'meson.build' file." + (define builder + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + + (define build-phases + #$(let ((phases (if (pair? phases) (sexp->gexp phases) phases))) + (if glib-or-gtk? + phases + #~(modify-phases #$phases + (delete 'glib-or-gtk-compile-schemas) + (delete 'glib-or-gtk-wrap))))) + + #$(with-build-variables inputs outputs + #~(meson-build #:source #+source + #:system #$system + #:outputs %outputs + #:inputs %build-inputs + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:phases build-phases + #:configure-flags #$(sexp->gexp configure-flags) + #:build-type #$build-type + #:tests? #$tests? + #:test-target #$test-target + #:parallel-build? #$parallel-build? + #:parallel-tests? #$parallel-tests? + #:validate-runpath? #$validate-runpath? + #:patch-shebangs? #$patch-shebangs? + #:strip-binaries? #$strip-binaries? + #:strip-flags #$(sexp->gexp strip-flags) + #:strip-directories #$(sexp->gexp strip-directories) + #:elf-directories #$(sexp->gexp elf-directories)))))) + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:target #f + #:substitutable? substitutable? + #:allowed-references allowed-references + #:disallowed-references disallowed-references + #:guile-for-build guile))) - ;; TODO: Copied from build-system/gnu, factorize this! - (define canonicalize-reference - (match-lambda - ((? package? p) - (derivation->output-path (package-derivation store p system - #:graft? #f))) - (((? package? p) output) - (derivation->output-path (package-derivation store p system - #:graft? #f) - output)) - ((? string? output) - output))) +(define* (meson-cross-build name + #:key + target + build-inputs host-inputs target-inputs + guile source + (outputs '("out")) + (configure-flags ''()) + (search-paths '()) + (native-search-paths '()) + (build-type "debugoptimized") + (tests? #f) + (test-target "test") + (glib-or-gtk? #f) + (parallel-build? #t) + (parallel-tests? #f) + (validate-runpath? #t) + (patch-shebangs? #t) + (strip-binaries? #t) + (strip-flags ''("--strip-debug")) + (strip-directories ''("lib" "lib64" "libexec" + "bin" "sbin")) + (elf-directories ''("lib" "lib64" "libexec" + "bin" "sbin")) + ;; See 'gnu-cross-build' for why this needs to be + ;; disabled when cross-compiling. + (make-dynamic-linker-cache? #f) + (phases '%standard-phases) + (system (%current-system)) + (imported-modules %meson-build-system-modules) + (modules '((guix build meson-build-system) + (guix build utils))) + allowed-references + disallowed-references) + "Cross-build SOURCE for TARGET using MESON, and with INPUTS, assuming that +SOURCE has a 'meson.build' file." + (define cross-file + (make-cross-file target)) + (define inputs + (if (null? target-inputs) + (input-tuples->gexp host-inputs) + #~(append #$(input-tuples->gexp host-inputs) + #+(input-tuples->gexp target-inputs)))) (define builder - `(let ((build-phases (if ,glib-or-gtk? - ,phases - (modify-phases ,phases - (delete 'glib-or-gtk-compile-schemas) - (delete 'glib-or-gtk-wrap))))) - (use-modules ,@modules) - (meson-build #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:outputs %outputs - #:inputs %build-inputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:phases build-phases - #:configure-flags ,configure-flags - #:build-type ,build-type - #:tests? ,tests? - #:test-target ,test-target - #:parallel-build? ,parallel-build? - #:parallel-tests? ,parallel-tests? - #:validate-runpath? ,validate-runpath? - #:patch-shebangs? ,patch-shebangs? - #:strip-binaries? ,strip-binaries? - #:strip-flags ,strip-flags - #:strip-directories ,strip-directories - #:elf-directories ,elf-directories))) - - (define guile-for-build - (match guile - ((? package?) - (package-derivation store guile system #:graft? #f)) - (#f ; the default - (let* ((distro (resolve-interface '(gnu packages commencement))) - (guile (module-ref distro 'guile-final))) - (package-derivation store guile system #:graft? #f))))) - - (build-expression->derivation store name builder - #:system system - #:inputs inputs - #:modules imported-modules - #:outputs outputs - #:guile-for-build guile-for-build - #:allowed-references - (and allowed-references - (map canonicalize-reference - allowed-references)) - #:disallowed-references - (and disallowed-references - (map canonicalize-reference - disallowed-references)))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + + (define build-phases + #$(let ((phases (if (pair? phases) (sexp->gexp phases) phases))) + (if glib-or-gtk? + phases + #~(modify-phases #$phases + (delete 'glib-or-gtk-compile-schemas) + (delete 'glib-or-gtk-wrap))))) + + ;; Do not use 'with-build-variables', as there should be + ;; no reason to use %build-inputs and friends. + (meson-build #:source #+source + #:system #$system + #:build #$(nix-system->gnu-triplet system) + #:target #$target + #:outputs #$(outputs->gexp outputs) + #:inputs #$inputs + #:native-inputs #+(input-tuples->gexp build-inputs) + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:native-search-paths '#$(sexp->gexp + (map search-path-specification->sexp + native-search-paths)) + #:phases build-phases + #:make-dynamic-linker-cache? #$make-dynamic-linker-cache? + #:configure-flags `("--cross-file" #+cross-file + ,@#$(sexp->gexp configure-flags)) + #:build-type #$build-type + #:tests? #$tests? + #:test-target #$test-target + #:parallel-build? #$parallel-build? + #:parallel-tests? #$parallel-tests? + #:validate-runpath? #$validate-runpath? + #:patch-shebangs? #$patch-shebangs? + #:strip-binaries? #$strip-binaries? + #:strip-flags #$(sexp->gexp strip-flags) + #:strip-directories #$(sexp->gexp strip-directories) + #:elf-directories #$(sexp->gexp elf-directories))))) + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:target target + #:substitutable? substitutable? + #:allowed-references allowed-references + #:disallowed-references disallowed-references + #:guile-for-build guile))) (define meson-build-system (build-system |