summaryrefslogtreecommitdiff
path: root/guix/build-system/linux-module.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/build-system/linux-module.scm')
-rw-r--r--guix/build-system/linux-module.scm270
1 files changed, 115 insertions, 155 deletions
diff --git a/guix/build-system/linux-module.scm b/guix/build-system/linux-module.scm
index 548ed7a9aa..e82a9ca65c 100644
--- a/guix/build-system/linux-module.scm
+++ b/guix/build-system/linux-module.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; This file is part of GNU Guix.
@@ -21,7 +22,8 @@
(define-module (guix build-system linux-module)
#:use-module (guix store)
#:use-module (guix utils)
- #:use-module (guix derivations)
+ #:use-module (guix gexp)
+ #:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
@@ -59,53 +61,52 @@
`(("linux" ,linux)))
(arguments
(substitute-keyword-arguments (package-arguments linux)
- ((#:phases phases)
- `(modify-phases ,phases
- (replace 'build
- (lambda _
- (invoke "make" "modules_prepare")))
- (delete 'strip) ; faster.
- (replace 'install
- (lambda* (#:key inputs outputs #:allow-other-keys)
- (let* ((out (assoc-ref outputs "out"))
- (out-lib-build (string-append out "/lib/modules/build")))
- ;; Delete some huge items that we probably don't need.
- ;; TODO: Only preserve the minimum, i.e. [Kbuild], Kconfig,
- ;; scripts, include, ".config".
- (copy-recursively "." out-lib-build)
- (for-each (lambda (name)
- (when (file-exists? name)
- (delete-file-recursively name)))
- (map (lambda (name)
- (string-append out-lib-build "/" name))
- '("arch" ; 137 MB
- ;"tools" ; 44 MB ; Note: is built by our 'build phase.
- "tools/testing" ; 14 MB
- "tools/perf" ; 17 MB
- "drivers" ; 600 MB
- "Documentation" ; 52 MB
- "fs" ; 43 MB
- "net" ; 33 MB
- "samples" ; 2 MB
- "sound"))) ; 40 MB
- ;; Reinstate arch/**/dts since "scripts/dtc" depends on it.
- ;; Reinstate arch/**/include directories.
- ;; Reinstate arch/**/Makefile.
- ;; Reinstate arch/**/module.lds.
- (for-each
- (lambda (name)
- (mkdir-p (dirname (string-append out-lib-build "/" name)))
- (copy-recursively name
- (string-append out-lib-build "/" name)))
- (append (find-files "arch" "^(dts|include)$" #:directories? #t)
- (find-files "arch" "^(Makefile|module.lds)$")))
- (let* ((linux (assoc-ref inputs "linux")))
- (install-file (string-append linux "/System.map")
- out-lib-build)
- (let ((source (string-append linux "/Module.symvers")))
- (when (file-exists? source)
- (install-file source out-lib-build))))
- #t)))))))))
+ ((#:phases phases)
+ #~(modify-phases #$phases
+ (replace 'build
+ (lambda _
+ (invoke "make" "modules_prepare")))
+ (delete 'strip) ; faster
+ (replace 'install
+ (lambda* (#:key inputs #:allow-other-keys)
+ (let ((out-lib-build (string-append #$output "/lib/modules/build")))
+ ;; Delete some huge items that we probably don't need.
+ ;; TODO: Only preserve the minimum, i.e. [Kbuild], Kconfig,
+ ;; scripts, include, ".config".
+ (copy-recursively "." out-lib-build)
+ (for-each (lambda (name)
+ (when (file-exists? name)
+ (delete-file-recursively name)))
+ (map (lambda (name)
+ (string-append out-lib-build "/" name))
+ '("arch" ; 137 MB
+ ;;"tools" ; 44 MB built by our 'build phase
+ "tools/testing" ; 14 MB
+ "tools/perf" ; 17 MB
+ "drivers" ; 600 MB
+ "Documentation" ; 52 MB
+ "fs" ; 43 MB
+ "net" ; 33 MB
+ "samples" ; 2 MB
+ "sound"))) ; 40 MB
+ ;; Reinstate arch/**/dts since "scripts/dtc" depends on it.
+ ;; Reinstate arch/**/include directories.
+ ;; Reinstate arch/**/Makefile.
+ ;; Reinstate arch/**/module.lds.
+ (for-each
+ (lambda (name)
+ (mkdir-p (dirname (string-append out-lib-build "/" name)))
+ (copy-recursively name
+ (string-append out-lib-build "/" name)))
+ (append (find-files "arch" "^(dts|include)$"
+ #:directories? #t)
+ (find-files "arch" "^(Makefile|module.lds)$")))
+ (let* ((linux #$(this-package-input "linux")))
+ (install-file (string-append linux "/System.map")
+ out-lib-build)
+ (let ((source (string-append linux "/Module.symvers")))
+ (when (file-exists? source)
+ (install-file source out-lib-build)))))))))))))
(define* (lower name
#:key source inputs native-inputs outputs
@@ -115,7 +116,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
- `(#:source #:target #:gcc #:kmod #:linux #:inputs #:native-inputs
+ `(#:target #:gcc #:kmod #:linux #:inputs #:native-inputs
,@(if target '() '(#:target))))
(bag
@@ -149,13 +150,12 @@
(build (if target linux-module-build-cross linux-module-build))
(arguments (strip-keyword-arguments private-keywords arguments))))
-(define* (linux-module-build store name inputs
+(define* (linux-module-build name inputs
#:key
- target
+ source target
(search-paths '())
(tests? #t)
- (phases '(@ (guix build linux-module-build-system)
- %standard-phases))
+ (phases '%standard-phases)
(outputs '("out"))
(make-flags ''())
(parallel-build? #t)
@@ -169,50 +169,38 @@
(guix build utils))))
"Build SOURCE using LINUX, and with INPUTS."
(define builder
- `(begin
- (use-modules ,@modules)
- (linux-module-build #:name ,name
- #:source ,(match (assoc-ref inputs "source")
- (((? derivation? source))
- (derivation->output-path source))
- ((source)
- source)
- (source
- source))
- #:source-directory ,source-directory
- #:search-paths ',(map search-path-specification->sexp
- search-paths)
- #:phases ,phases
- #:system ,system
- #:target ,target
- #:arch ,(system->arch (or target system))
- #:tests? ,tests?
- #:outputs %outputs
- #:make-flags ,make-flags
- #:parallel-build? ,parallel-build?
- #:inputs %build-inputs)))
+ (with-imported-modules imported-modules
+ #~(begin
+ (use-modules #$@(sexp->gexp modules))
+ #$(with-build-variables inputs outputs
+ #~(linux-module-build #:name #$name
+ #:source #+source
+ #:source-directory #$source-directory
+ #:search-paths '#$(sexp->gexp
+ (map search-path-specification->sexp
+ search-paths))
+ #:phases #$phases
+ #:system #$system
+ #:target #$target
+ #:arch #$(system->arch (or target system))
+ #:tests? #$tests?
+ #:outputs #$(outputs->gexp outputs)
+ #:make-flags #$make-flags
+ #:parallel-build? #$parallel-build?
+ #:inputs #$(input-tuples->gexp 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 inputs
- #:modules imported-modules
- #:outputs outputs
- #:guile-for-build guile-for-build
- #:substitutable? substitutable?))
+ (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+ system #:graft? #f)))
+ (gexp->derivation name builder
+ #:system system
+ #:guile-for-build guile
+ #:substitutable? substitutable?)))
(define* (linux-module-build-cross
- store name
+ name
#:key
- target native-drvs target-drvs
+ source target
+ build-inputs target-inputs host-inputs
(guile #f)
(outputs '("out"))
(make-flags ''())
@@ -220,8 +208,7 @@
(search-paths '())
(native-search-paths '())
(tests? #f)
- (phases '(@ (guix build linux-module-build-system)
- %standard-phases))
+ (phases '%standard-phases)
(system (%current-system))
(substitutable? #t)
(imported-modules
@@ -229,70 +216,43 @@
(modules '((guix build linux-module-build-system)
(guix build utils))))
(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))
+ (with-imported-modules imported-modules
+ #~(begin
+ (use-modules #$@(sexp->gexp modules))
- (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))
+ (define %build-host-inputs
+ '#+(input-tuples->gexp build-inputs))
- (linux-module-build #:name ,name
- #:source ,(match (assoc-ref native-drvs "source")
- (((? derivation? source))
- (derivation->output-path source))
- ((source)
- source)
- (source
- source))
- #:system ,system
- #:target ,target
- #:arch ,(system->arch (or target system))
- #:outputs %outputs
- #:make-flags ,make-flags
- #: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)
- #:phases ,phases
- #:tests? ,tests?))))
+ (define %build-target-inputs
+ (append #$(input-tuples->gexp host-inputs)
+ #+(input-tuples->gexp target-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)))))
+ (linux-module-build #:name #$name
+ #:source #+source
+ #:system #$system
+ #:target #$target
+ #:arch #$(system->arch (or target system))
+ #:outputs #$(outputs->gexp outputs)
+ #:make-flags #$make-flags
+ #:inputs %build-target-inputs
+ #:native-inputs %build-host-inputs
+ #:search-paths
+ '#$(sexp->gexp
+ (map search-path-specification->sexp
+ search-paths))
+ #:native-search-paths
+ '#$(map
+ search-path-specification->sexp
+ native-search-paths)
+ #:phases #$phases
+ #:tests? #$tests?))))
- (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
- #:substitutable? substitutable?))
+ (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+ system #:graft? #f)))
+ (gexp->derivation name builder
+ #:system system
+ #:guile-for-build guile
+ #:substitutable? substitutable?)))
(define linux-module-build-system
(build-system
generated by cgit v1.2.3 (git 2.50.1) at 2025-08-09 09:33:30 +0000