summaryrefslogtreecommitdiff
path: root/guix/build-system/meson.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/build-system/meson.scm')
-rw-r--r--guix/build-system/meson.scm335
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
generated by cgit v1.2.3 (git 2.45.2) at 2024-07-02 02:05:21 +0000