diff options
author | Ludovic Courtès <ludo@gnu.org> | 2017-12-10 23:39:01 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2017-12-10 23:44:58 +0100 |
commit | 8bc1935c7ce2a63b058b21db206d09e0e5872ab4 (patch) | |
tree | 28991891447b84a0a0f4d37e8229a13f6ca304aa /guix/build-system | |
parent | 6146603d5412fbc5803a7ed17f5a6744ea11b527 (diff) | |
download | gnu-guix-8bc1935c7ce2a63b058b21db206d09e0e5872ab4.tar gnu-guix-8bc1935c7ce2a63b058b21db206d09e0e5872ab4.tar.gz |
build-system/asdf: Use 'mlambda'.
* guix/build-system/asdf.scm (package-with-build-system): Use 'mlambda'
instead of 'memoize'.
Diffstat (limited to 'guix/build-system')
-rw-r--r-- | guix/build-system/asdf.scm | 124 |
1 files changed, 62 insertions, 62 deletions
diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm index ec8b64497f..ab0ae57c6e 100644 --- a/guix/build-system/asdf.scm +++ b/guix/build-system/asdf.scm @@ -19,6 +19,7 @@ (define-module (guix build-system asdf) #:use-module (guix store) #:use-module (guix utils) + #:use-module (guix memoization) #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix search-paths) @@ -160,70 +161,69 @@ set up using CL source package conventions." (eq? from-build-system (package-build-system pkg))) (define transform - (memoize - (lambda (pkg) - (define rewrite - (match-lambda - ((name content . rest) - (let* ((is-package? (package? content)) - (new-content (if is-package? (transform content) content))) - `(,name ,new-content ,@rest))))) - - ;; Special considerations for source packages: CL inputs become - ;; propagated, and un-handled arguments are removed. - - (define new-propagated-inputs - (if target-is-source? - (map rewrite - (append - (filter (match-lambda - ((_ input . _) - (has-from-build-system? input))) - (append (package-inputs pkg) - ;; The native inputs might be needed just - ;; to load the system. - (package-native-inputs pkg))) - (package-propagated-inputs pkg))) - - (map rewrite (package-propagated-inputs pkg)))) - - (define (new-inputs inputs-getter) - (if target-is-source? - (map rewrite + (mlambda (pkg) + (define rewrite + (match-lambda + ((name content . rest) + (let* ((is-package? (package? content)) + (new-content (if is-package? (transform content) content))) + `(,name ,new-content ,@rest))))) + + ;; Special considerations for source packages: CL inputs become + ;; propagated, and un-handled arguments are removed. + + (define new-propagated-inputs + (if target-is-source? + (map rewrite + (append (filter (match-lambda ((_ input . _) - (not (has-from-build-system? input)))) - (inputs-getter pkg))) - (map rewrite (inputs-getter pkg)))) - - (define base-arguments - (if target-is-source? - (strip-keyword-arguments - '(#:tests? #:asd-file #:lisp #:asd-system-name #:test-asd-file) - (package-arguments pkg)) - (package-arguments pkg))) - - (cond - ((and variant-property - (assoc-ref (package-properties pkg) variant-property)) - => force) - - ((has-from-build-system? pkg) - (package - (inherit pkg) - (location (package-location pkg)) - (name (transform-package-name (package-name pkg))) - (build-system to-build-system) - (arguments - (substitute-keyword-arguments base-arguments - ((#:phases phases) (list phases-transformer phases)))) - (inputs (new-inputs package-inputs)) - (propagated-inputs new-propagated-inputs) - (native-inputs (new-inputs package-native-inputs)) - (outputs (if target-is-source? - '("out") - (package-outputs pkg))))) - (else pkg))))) + (has-from-build-system? input))) + (append (package-inputs pkg) + ;; The native inputs might be needed just + ;; to load the system. + (package-native-inputs pkg))) + (package-propagated-inputs pkg))) + + (map rewrite (package-propagated-inputs pkg)))) + + (define (new-inputs inputs-getter) + (if target-is-source? + (map rewrite + (filter (match-lambda + ((_ input . _) + (not (has-from-build-system? input)))) + (inputs-getter pkg))) + (map rewrite (inputs-getter pkg)))) + + (define base-arguments + (if target-is-source? + (strip-keyword-arguments + '(#:tests? #:asd-file #:lisp #:asd-system-name #:test-asd-file) + (package-arguments pkg)) + (package-arguments pkg))) + + (cond + ((and variant-property + (assoc-ref (package-properties pkg) variant-property)) + => force) + + ((has-from-build-system? pkg) + (package + (inherit pkg) + (location (package-location pkg)) + (name (transform-package-name (package-name pkg))) + (build-system to-build-system) + (arguments + (substitute-keyword-arguments base-arguments + ((#:phases phases) (list phases-transformer phases)))) + (inputs (new-inputs package-inputs)) + (propagated-inputs new-propagated-inputs) + (native-inputs (new-inputs package-native-inputs)) + (outputs (if target-is-source? + '("out") + (package-outputs pkg))))) + (else pkg)))) transform) |