03/06: build-system/python: 'package-with-explicit-python' uses 'package-mapping'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 1618006d0bc9bfdc63f4d199fd980f29ecc78ec4
Author: Ludovic Courtès <address@hidden>
Date:   Wed Apr 5 21:32:13 2017 +0200

    build-system/python: 'package-with-explicit-python' uses 'package-mapping'.
    
    * guix/build-system/python.scm (package-with-explicit-python)
    [package-variant, cut?]: New procedures.
    [transform]: Remove 'mlambdaq' form and input tuple handling.
    Use 'package-mapping'.
---
 guix/build-system/python.scm | 85 +++++++++++++++++++-------------------------
 1 file changed, 37 insertions(+), 48 deletions(-)

diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm
index 17173f1..ffed837 100644
--- a/guix/build-system/python.scm
+++ b/guix/build-system/python.scm
@@ -83,54 +83,43 @@ pre-defined variants of this transformation recorded in the 
'properties' field
 of packages.  The property value must be the promise of a package.  This is a
 convenient way for package writers to force the transformation to use
 pre-defined variants."
-  (define transform
-    ;; Memoize the transformations.  Failing to do that, we would build a huge
-    ;; object graph with lots of duplicates, which in turns prevents us from
-    ;; benefiting from memoization in 'package-derivation'.
-    (mlambdaq (p)
-      (let* ((rewrite-if-package
-              (lambda (content)
-                ;; CONTENT may be a file name, in which case it is returned,
-                ;; or a package, which is rewritten with the new PYTHON and
-                ;; NEW-PREFIX.
-                (if (package? content)
-                    (transform content)
-                    content)))
-             (rewrite
-              (match-lambda
-                ((name content . rest)
-                 (append (list name (rewrite-if-package content)) rest)))))
-
-        (cond
-         ;; If VARIANT-PROPERTY is present, use that.
-         ((and variant-property
-               (assoc-ref (package-properties p) variant-property))
-          => force)
-
-         ;; Otherwise build the new package object graph.
-         ((eq? (package-build-system p) python-build-system)
-          (package
-            (inherit p)
-            (location (package-location p))
-            (name (let ((name (package-name p)))
-                    (string-append new-prefix
-                                   (if (string-prefix? old-prefix name)
-                                       (substring name
-                                                  (string-length old-prefix))
-                                       name))))
-            (arguments
-             (let ((python (if (promise? python)
-                               (force python)
-                               python)))
-               (ensure-keyword-arguments (package-arguments p)
-                                         `(#:python ,python))))
-            (inputs (map rewrite (package-inputs p)))
-            (propagated-inputs (map rewrite (package-propagated-inputs p)))
-            (native-inputs (map rewrite (package-native-inputs p)))))
-         (else
-          p)))))
-
-  transform)
+  (define package-variant
+    (if variant-property
+        (lambda (package)
+          (assq-ref (package-properties package)
+                    variant-property))
+        (const #f)))
+
+  (define (transform p)
+    (cond
+     ;; If VARIANT-PROPERTY is present, use that.
+     ((package-variant p)
+      => force)
+
+     ;; Otherwise build the new package object graph.
+     ((eq? (package-build-system p) python-build-system)
+      (package
+        (inherit p)
+        (location (package-location p))
+        (name (let ((name (package-name p)))
+                (string-append new-prefix
+                               (if (string-prefix? old-prefix name)
+                                   (substring name
+                                              (string-length old-prefix))
+                                   name))))
+        (arguments
+         (let ((python (if (promise? python)
+                           (force python)
+                           python)))
+           (ensure-keyword-arguments (package-arguments p)
+                                     `(#:python ,python))))))
+     (else p)))
+
+  (define (cut? p)
+    (or (not (eq? (package-build-system p) python-build-system))
+        (package-variant p)))
+
+  (package-mapping transform cut?))
 
 (define package-with-python2
   ;; Note: delay call to 'default-python2' until after the 'arguments' field