summaryrefslogtreecommitdiff
path: root/guix/build-system/go.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/build-system/go.scm')
-rw-r--r--guix/build-system/go.scm163
1 files changed, 147 insertions, 16 deletions
diff --git a/guix/build-system/go.scm b/guix/build-system/go.scm
index 8f55796e86..4c1a732107 100644
--- a/guix/build-system/go.scm
+++ b/guix/build-system/go.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2016 Petter <petter@mykolab.ch>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
+;;; Copyright © 2021 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -27,6 +28,7 @@
#:use-module (guix packages)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
+ #:use-module (srfi srfi-1)
#:export (%go-build-system-modules
go-build
go-build-system
@@ -78,6 +80,24 @@ present) if a pseudo-version pattern is not recognized."
commit hash and its date rather than a proper release tag."
(regexp-exec %go-pseudo-version-rx version))
+(define (go-target target)
+ ;; Parse the nix-system equivalent of the target and set the
+ ;; target for compilation accordingly.
+ (match (string-split (gnu-triplet->nix-system target) #\-)
+ ((arch os)
+ (list (match arch
+ ("aarch64" "arm64")
+ ("armhf" "arm")
+ ("powerpc64le" "ppc64le")
+ ("powerpc64" "ppc64")
+ ("i686" "386")
+ ("x86_64" "amd64")
+ ("mips64el" "mips64le")
+ (_ arch))
+ (match os
+ ((or "mingw32" "cygwin") "windows")
+ (_ os))))))
+
(define %go-build-system-modules
;; Build-side modules imported and used by default.
`((guix build go-build-system)
@@ -98,22 +118,37 @@ commit hash and its date rather than a proper release tag."
(define private-keywords
'(#:source #:target #:go #:inputs #:native-inputs))
- (and (not target) ;XXX: no cross-compilation
- (bag
- (name name)
- (system system)
- (host-inputs `(,@(if source
- `(("source" ,source))
- '())
- ,@inputs
-
- ;; Keep the standard inputs of 'gnu-build-system'.
- ,@(standard-packages)))
- (build-inputs `(("go" ,go)
- ,@native-inputs))
- (outputs outputs)
- (build go-build)
- (arguments (strip-keyword-arguments private-keywords arguments)))))
+ (bag
+ (name name)
+ (system system)
+ (target target)
+ (build-inputs `(,@(if source
+ `(("source" ,source))
+ '())
+ ,@`(("go" ,go))
+ ,@native-inputs
+ ,@(if target '() inputs)
+ ,@(if target
+ ;; Use the standard cross inputs of
+ ;; 'gnu-build-system'.
+ (standard-cross-packages target 'host)
+ '())
+ ;; Keep the standard inputs of 'gnu-build-system'.
+ ,@(standard-packages)))
+ (host-inputs (if target inputs '()))
+
+ ;; The cross-libc is really a target package, but for bootstrapping
+ ;; reasons, we can't put it in 'host-inputs'. Namely, 'cross-gcc' is a
+ ;; native package, so it would end up using a "native" variant of
+ ;; 'cross-libc' (built with 'gnu-build'), whereas all the other packages
+ ;; would use a target variant (built with 'gnu-cross-build'.)
+ (target-inputs (if target
+ (standard-cross-packages target 'target)
+ '()))
+
+ (outputs outputs)
+ (build (if target go-cross-build go-build))
+ (arguments (strip-keyword-arguments private-keywords arguments))))
(define* (go-build store name inputs
#:key
@@ -128,6 +163,8 @@ commit hash and its date rather than a proper release tag."
(tests? #t)
(allow-go-reference? #f)
(system (%current-system))
+ (goarch (first (go-target (%current-system))))
+ (goos (last (go-target (%current-system))))
(guile #f)
(imported-modules %go-build-system-modules)
(modules '((guix build go-build-system)
@@ -147,6 +184,8 @@ commit hash and its date rather than a proper release tag."
#:system ,system
#:phases ,phases
#:outputs %outputs
+ #:goarch ,goarch
+ #:goos ,goos
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:install-source? ,install-source?
@@ -174,6 +213,98 @@ commit hash and its date rather than a proper release tag."
#:outputs outputs
#:guile-for-build guile-for-build))
+(define* (go-cross-build store name
+ #:key
+ target native-drvs target-drvs
+ (phases '(@ (guix build go-build-system)
+ %standard-phases))
+ (outputs '("out"))
+ (search-paths '())
+ (native-search-paths '())
+ (install-source? #t)
+ (import-path "")
+ (unpack-path "")
+ (build-flags ''())
+ (tests? #f) ; nothing can be done
+ (allow-go-reference? #f)
+ (system (%current-system))
+ (goarch (first (go-target target)))
+ (goos (last (go-target target)))
+ (guile #f)
+ (imported-modules %go-build-system-modules)
+ (modules '((guix build go-build-system)
+ (guix build union)
+ (guix build utils))))
+ "Cross-build NAME using GO, where TARGET is a GNU triplet and with INPUTS."
+ (define builder
+ `(begin
+ (use-modules ,@modules)
+ (let ()
+ (define %build-host-inputs
+ ',(map (match-lambda
+ ((name (? derivation? drv) sub ...)
+ `(,name . ,(apply derivation->output-path drv sub)))
+ ((name path)
+ `(,name . ,path)))
+ native-drvs))
+
+ (define %build-target-inputs
+ ',(map (match-lambda
+ ((name (? derivation? drv) sub ...)
+ `(,name . ,(apply derivation->output-path drv sub)))
+ ((name (? package? pkg) sub ...)
+ (let ((drv (package-cross-derivation store pkg
+ target system)))
+ `(,name . ,(apply derivation->output-path drv sub))))
+ ((name path)
+ `(,name . ,path)))
+ target-drvs))
+
+ (go-build #:name ,name
+ #:source ,(match (assoc-ref native-drvs "source")
+ (((? derivation? source))
+ (derivation->output-path source))
+ ((source)
+ source)
+ (source
+ source))
+ #:system ,system
+ #:phases ,phases
+ #:outputs %outputs
+ #:target ,target
+ #:goarch ,goarch
+ #:goos ,goos
+ #:inputs %build-target-inputs
+ #:native-inputs %build-host-inputs
+ #:search-paths ',(map search-path-specification->sexp
+ search-paths)
+ #:native-search-paths ',(map
+ search-path-specification->sexp
+ native-search-paths)
+ #:install-source? ,install-source?
+ #:import-path ,import-path
+ #:unpack-path ,unpack-path
+ #:build-flags ,build-flags
+ #:tests? ,tests?
+ #:allow-go-reference? ,allow-go-reference?
+ #:inputs %build-inputs))))
+
+ (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 (append native-drvs target-drvs)
+ #:outputs outputs
+ #:modules imported-modules
+ #:guile-for-build guile-for-build))
+
(define go-build-system
(build-system
(name 'go)