01/02: build-system/asdf: Use 'mlambda'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 8bc1935c7ce2a63b058b21db206d09e0e5872ab4
Author: Ludovic Courtès <address@hidden>
Date:   Sun Dec 10 23:39:01 2017 +0100

    build-system/asdf: Use 'mlambda'.
    
    * guix/build-system/asdf.scm (package-with-build-system): Use 'mlambda'
    instead of 'memoize'.
---
 guix/build-system/asdf.scm | 124 ++++++++++++++++++++++-----------------------
 1 file changed, 62 insertions(+), 62 deletions(-)

diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm
index ec8b644..ab0ae57 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)