build-system/go: Update cross-compilation support to new interface.

* guix/build-system/go.scm (go-cross-build): Remove 'store', 'native-drvs'
and 'target-drvs'; add 'source', 'build-inputs', 'target-inputs', and
'host-inputs'.  Change default value of #:phases.
[builder]: Rewrite as a gexp.
Rewrite body to call 'gexp->derivation' instead of
'build-expression->derivation'.
This commit is contained in:
Ludovic Courtès 2021-11-18 22:32:25 +01:00
parent 8362046a06
commit e37dcf63dc
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5

@ -201,11 +201,11 @@ commit hash and its date rather than a proper release tag."
#:system system #:system system
#:guile-for-build guile))) #:guile-for-build guile)))
(define* (go-cross-build store name (define* (go-cross-build name
#:key #:key
target native-drvs target-drvs source target
(phases '(@ (guix build go-build-system) build-inputs target-inputs host-inputs
%standard-phases)) (phases '%standard-phases)
(outputs '("out")) (outputs '("out"))
(search-paths '()) (search-paths '())
(native-search-paths '()) (native-search-paths '())
@ -213,7 +213,7 @@ commit hash and its date rather than a proper release tag."
(import-path "") (import-path "")
(unpack-path "") (unpack-path "")
(build-flags ''()) (build-flags ''())
(tests? #f) ; nothing can be done (tests? #f) ; nothing can be done
(allow-go-reference? #f) (allow-go-reference? #f)
(system (%current-system)) (system (%current-system))
(goarch (first (go-target target))) (goarch (first (go-target target)))
@ -225,73 +225,53 @@ commit hash and its date rather than a proper release tag."
(guix build utils)))) (guix build utils))))
"Cross-build NAME using GO, where TARGET is a GNU triplet and with INPUTS." "Cross-build NAME using GO, where TARGET is a GNU triplet and with INPUTS."
(define builder (define builder
`(begin #~(begin
(use-modules ,@modules) (use-modules #$@(sexp->gexp 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 (define %build-host-inputs
',(map (match-lambda #+(input-tuples->gexp build-inputs))
((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 (define %build-target-inputs
#:source ,(match (assoc-ref native-drvs "source") (append #$(input-tuples->gexp host-inputs)
(((? derivation? source)) #+(input-tuples->gexp target-inputs)))
(derivation->output-path source))
((source) (define %build-inputs
source) (append %build-host-inputs %build-target-inputs))
(source
source)) (define %outputs
#:system ,system #$(outputs->gexp outputs))
#:phases ,phases
#:outputs %outputs (go-build #:name #$name
#:target ,target #:source #+source
#:goarch ,goarch #:system #$system
#:goos ,goos #:phases #$phases
#:inputs %build-target-inputs #:outputs %outputs
#:native-inputs %build-host-inputs #:target #$target
#:search-paths ',(map search-path-specification->sexp #:goarch #$goarch
#:goos #$goos
#:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths '#$(map search-path-specification->sexp
search-paths) search-paths)
#:native-search-paths ',(map #:native-search-paths '#$(map
search-path-specification->sexp search-path-specification->sexp
native-search-paths) native-search-paths)
#:install-source? ,install-source? #:install-source? #$install-source?
#:import-path ,import-path #:import-path #$import-path
#:unpack-path ,unpack-path #:unpack-path #$unpack-path
#:build-flags ,build-flags #:build-flags #$build-flags
#:tests? ,tests? #:tests? #$tests?
#:allow-go-reference? ,allow-go-reference? #:allow-go-reference? #$allow-go-reference?
#:inputs %build-inputs)))) #:inputs %build-inputs)))
(define guile-for-build (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
(match guile system #:graft? #f)))
((? package?) (gexp->derivation name builder
(package-derivation store guile system #:graft? #f)) #:system system
(#f ; the default #:target target
(let* ((distro (resolve-interface '(gnu packages commencement))) #:graft? #f
(guile (module-ref distro 'guile-final))) #:substitutable? substitutable?
(package-derivation store guile system #:graft? #f))))) #:guile-for-build guile)))
(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 (define go-build-system
(build-system (build-system