@@ -234,6 +234,7 @@ MODULES = \
guix/build/emacs-utils.scm \
guix/build/java-utils.scm \
guix/build/lisp-utils.scm \
+ guix/build/meson-configuration.scm \
guix/build/maven/java.scm \
guix/build/maven/plugin.scm \
guix/build/maven/pom.scm \
@@ -2,6 +2,7 @@
;;; 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.
;;;
@@ -30,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:
;;
@@ -40,6 +42,66 @@
;;
;; Code:
+(define (target-hurd? triplet)
+ (and (string-suffix? "-gnu" triplet)
+ (not (string-contains triplet "linux"))))
+
+(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")
+ (#t (error "meson: unknown CPU"))))
+ (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 has a big-endian
+ ;; mode as well.
+ ((target-aarch64? 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 (f)
+ (parameterize ((configuration-port f))
+ (write-section-header "host_machine")
+ (write-assignments '#$(make-machine-alist triplet))
+ (write-section-header "binaries")
+ (write-assignments '#$(make-binaries-alist triplet)))))))))
+
(define %meson-build-system-modules
;; Build-side modules imported by default.
`((guix build meson-build-system)
@@ -68,24 +130,34 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
- `(#: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)))))
+ `(#: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
@@ -161,6 +233,97 @@ has a 'meson.build' file."
#:disallowed-references disallowed-references
#:guile-for-build guile)))
+(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"))
+ (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
+ (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
+ #: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
+ #: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
(name 'meson)
new file mode 100644
@@ -0,0 +1,71 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build meson-configuration)
+ #:use-module (ice-9 match)
+ #:export (write-section-header write-assignment
+ write-assignments make-machine-alist
+ configuration-port))
+
+;; Commentary:
+;;
+;; Utilities for generating a ‘Cross build definition file’ for
+;; the Meson build system. Configuration values are currently
+;; never escaped. In practice this is unlikely to be a problem
+;; in the build environment.
+;;
+;; Code:
+
+(define configuration-port
+ (fluid->parameter (make-unbound-fluid)))
+
+(define (write-section-header section-name)
+ "Write a section header for section named SECTION-NAME
+to the configuration port."
+ (format (configuration-port) "[~a]~%" section-name))
+
+(define (write-assignment key value)
+ "Write an assignment of VALUE to KEY to the configuration
+port. VALUE must be a string (without any special characters
+such as quotes), a boolean or an integer. Lists are currently
+not supported"
+ (define port (configuration-port))
+ (match value
+ ((? string?)
+ (format port "~a = '~a'~%" key value))
+ ((? integer?)
+ (format port "~a = ~a~%" key value))
+ (#f
+ (format port "~a = true~%" key))
+ (#t
+ (format port "~a = false~%" key))))
+
+(define* (write-assignments alist)
+ "Write the assignments in ALIST, an association list,
+to the configuration port."
+ (for-each (match-lambda
+ ((key . value)
+ (write-assignment key value)))
+ alist))
+
+(define* (make-machine-alist #:key system cpu-family cpu endian)
+ "Make an association list for the [host_machine] section."
+ `((system . ,system)
+ (cpu-family . ,cpu-family)
+ (cpu . ,cpu)
+ (endian . ,endian)))