summaryrefslogtreecommitdiff
path: root/guix/build-system/asdf.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/build-system/asdf.scm')
-rw-r--r--guix/build-system/asdf.scm146
1 files changed, 61 insertions, 85 deletions
diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm
index b4e40ee8c2..f043e6a7a2 100644
--- a/guix/build-system/asdf.scm
+++ b/guix/build-system/asdf.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
;;; Copyright © 2019, 2020, 2021 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -22,7 +23,8 @@
#:use-module (guix utils)
#:use-module (guix memoization)
#:use-module (guix packages)
- #:use-module (guix derivations)
+ #:use-module (guix gexp)
+ #:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module ((guix build utils)
#:select ((package-name->name+version
@@ -92,46 +94,33 @@
(build asdf-build/source)
(arguments (strip-keyword-arguments private-keywords arguments)))))
-(define* (asdf-build/source store name inputs
+(define* (asdf-build/source name inputs
#:key source outputs
- (phases '(@ (guix build asdf-build-system)
- %standard-phases/source))
+ (phases '%standard-phases/source)
(search-paths '())
(system (%current-system))
(guile #f)
(imported-modules %asdf-build-system-modules)
(modules %asdf-build-modules))
(define builder
- `(begin
- (use-modules ,@modules)
- (asdf-build/source #:name ,name
- #:source ,(match (assoc-ref inputs "source")
- (((? derivation? source))
- (derivation->output-path source))
- ((source) source)
- (source source))
- #:system ,system
- #:phases ,phases
- #:outputs %outputs
- #:search-paths ',(map search-path-specification->sexp
- search-paths)
- #:inputs %build-inputs)))
-
- (define guile-for-build
- (match guile
- ((? package?)
- (package-derivation store guile system #:graft? #f))
- (#f
- (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
- #:inputs inputs
- #:system system
- #:modules imported-modules
- #:outputs outputs
- #:guile-for-build guile-for-build))
+ (with-imported-modules imported-modules
+ #~(begin
+ (use-modules #$@(sexp->gexp modules))
+ (asdf-build/source #:name #$name
+ #:source #+source
+ #:system #$system
+ #:phases #$phases
+ #:outputs #$(outputs->gexp outputs)
+ #:search-paths '#$(sexp->gexp
+ (map search-path-specification->sexp
+ search-paths))
+ #:inputs #$(input-tuples->gexp inputs)))))
+
+ (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+ system #:graft? #f)))
+ (gexp->derivation name builder
+ #:system system
+ #:guile-for-build guile)))
(define* (package-with-build-system from-build-system to-build-system
from-prefix to-prefix
@@ -277,19 +266,18 @@ set up using CL source package conventions."
(arguments (strip-keyword-arguments private-keywords arguments))))))
(define (asdf-build lisp-type)
- (lambda* (store name inputs
- #:key source outputs
- (tests? #t)
- (asd-files ''())
- (asd-systems ''())
- (test-asd-file #f)
- (phases '(@ (guix build asdf-build-system)
- %standard-phases))
- (search-paths '())
- (system (%current-system))
- (guile #f)
- (imported-modules %asdf-build-system-modules)
- (modules %asdf-build-modules))
+ (lambda* (name inputs
+ #:key source outputs
+ (tests? #t)
+ (asd-files ''())
+ (asd-systems ''())
+ (test-asd-file #f)
+ (phases '%standard-phases)
+ (search-paths '())
+ (system (%current-system))
+ (guile #f)
+ (imported-modules %asdf-build-system-modules)
+ (modules %asdf-build-modules))
(define systems
(if (null? (cadr asd-systems))
@@ -304,44 +292,32 @@ set up using CL source package conventions."
asd-systems))
(define builder
- `(begin
- (use-modules ,@modules)
- (parameterize ((%lisp (string-append
- (assoc-ref %build-inputs ,lisp-type)
- "/bin/" ,lisp-type))
- (%lisp-type ,lisp-type))
- (asdf-build #:name ,name
- #:source ,(match (assoc-ref inputs "source")
- (((? derivation? source))
- (derivation->output-path source))
- ((source) source)
- (source source))
- #:asd-files ,asd-files
- #:asd-systems ,systems
- #:test-asd-file ,test-asd-file
- #:system ,system
- #:tests? ,tests?
- #:phases ,phases
- #:outputs %outputs
- #:search-paths ',(map search-path-specification->sexp
- search-paths)
- #:inputs %build-inputs))))
-
- (define guile-for-build
- (match guile
- ((? package?)
- (package-derivation store guile system #:graft? #f))
- (#f
- (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
- #:inputs inputs
- #:system system
- #:modules imported-modules
- #:outputs outputs
- #:guile-for-build guile-for-build)))
+ (with-imported-modules imported-modules
+ #~(begin
+ (use-modules #$@(sexp->gexp modules))
+ (parameterize ((%lisp (search-input-file
+ #$(input-tuples->gexp inputs)
+ (string-append "bin/" #$lisp-type)))
+ (%lisp-type #$lisp-type))
+ (asdf-build #:name #$name
+ #:source #+source
+ #:asd-files #$asd-files
+ #:asd-systems #$systems
+ #:test-asd-file #$test-asd-file
+ #:system #$system
+ #:tests? #$tests?
+ #:phases #$phases
+ #:outputs #$(outputs->gexp outputs)
+ #:search-paths '#$(sexp->gexp
+ (map search-path-specification->sexp
+ search-paths))
+ #:inputs #$(input-tuples->gexp inputs))))))
+
+ (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+ system #:graft? #f)))
+ (gexp->derivation name builder
+ #:system system
+ #:guile-for-build guile))))
(define asdf-build-system/sbcl
(build-system