From b334674fe5e99209e4f726e0d692ffa6bab9d6a1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sun, 25 Jun 2017 15:33:58 +0200
Subject: [PATCH] Use 'mapm' instead of 'sequence' + 'map'.

Previously we'd use the (sequence M (map P L)) idiom just because 'mapm'
was slower (not specialized for the given monad).  This is no longer the
case since commit dcb95c1fc936d74dfdf84b7e59eff66cb99c5a63.

* guix/gexp.scm (lower-inputs): Use (mapm M P L) instead of (sequence
M (map P L)).
(lower-references, gexp->sexp, imported-files): Likewise.
* guix/profiles.scm (profile-derivation): Likewise.
* guix/scripts/environment.scm (inputs->requisites): Likewise.
* guix/scripts/system.scm (copy-closure): Likewise.
---
 guix/gexp.scm                | 45 ++++++++++++++++++------------------
 guix/profiles.scm            |  8 +++----
 guix/scripts/environment.scm |  4 ++--
 3 files changed, 28 insertions(+), 29 deletions(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index fd3b6be348..88cabc8ed5 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -566,15 +566,15 @@ list."
 corresponding input list as a monadic value.  When TARGET is true, use it as
 the cross-compilation target triplet."
   (with-monad %store-monad
-    (sequence %store-monad
-              (map (match-lambda
-                     (((? struct? thing) sub-drv ...)
-                      (mlet %store-monad ((drv (lower-object
-                                                thing system #:target target)))
-                        (return `(,drv ,@sub-drv))))
-                     (input
-                      (return input)))
-                   inputs))))
+    (mapm %store-monad
+          (match-lambda
+            (((? struct? thing) sub-drv ...)
+             (mlet %store-monad ((drv (lower-object
+                                       thing system #:target target)))
+               (return `(,drv ,@sub-drv))))
+            (input
+             (return input)))
+          inputs)))
 
 (define* (lower-reference-graphs graphs #:key system target)
   "Given GRAPHS, a list of (FILE-NAME INPUT ...) lists for use as a
@@ -606,7 +606,7 @@ names and file names suitable for the #:allowed-references argument to
                                                #:target target)))
           (return (derivation->output-path drv))))))
 
-    (sequence %store-monad (map lower lst))))
+    (mapm %store-monad lower lst)))
 
 (define default-guile-derivation
   ;; Here we break the abstraction by talking to the higher-level layer.
@@ -880,15 +880,15 @@ and in the current monad setting (system type, etc.)"
                      #:system system
                      #:target (if (or n? native?) #f target)))
         (($ <gexp-input> (refs ...) output n?)
-         (sequence %store-monad
-                   (map (lambda (ref)
-                          ;; XXX: Automatically convert REF to an gexp-input.
-                          (reference->sexp
-                           (if (gexp-input? ref)
-                               ref
-                               (%gexp-input ref "out" n?))
-                           (or n? native?)))
-                        refs)))
+         (mapm %store-monad
+               (lambda (ref)
+                 ;; XXX: Automatically convert REF to an gexp-input.
+                 (reference->sexp
+                  (if (gexp-input? ref)
+                      ref
+                      (%gexp-input ref "out" n?))
+                  (or n? native?)))
+               refs))
         (($ <gexp-input> (? struct? thing) output n?)
          (let ((target (if (or n? native?) #f target))
                (expand (lookup-expander thing)))
@@ -902,8 +902,8 @@ and in the current monad setting (system type, etc.)"
          (return x)))))
 
   (mlet %store-monad
-      ((args (sequence %store-monad
-                       (map reference->sexp (gexp-references exp)))))
+      ((args (mapm %store-monad
+                   reference->sexp (gexp-references exp))))
     (return (apply (gexp-proc exp) args))))
 
 (define (syntax-location-string s)
@@ -1117,8 +1117,7 @@ to the source files instead of copying them."
       (mlet %store-monad ((file (lower-object file-like system)))
         (return (list final-path file))))))
 
-  (mlet %store-monad ((files (sequence %store-monad
-                                       (map file-pair files))))
+  (mlet %store-monad ((files (mapm %store-monad file-pair files)))
     (define build
       (gexp
        (begin
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 6d5da0ac4c..8142e5e8e2 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1383,10 +1383,10 @@ are cross-built for TARGET."
                                                          #:target target)))
                        (extras (if (null? (manifest-entries manifest))
                                    (return '())
-                                   (sequence %store-monad
-                                             (map (lambda (hook)
-                                                    (hook manifest))
-                                                  hooks)))))
+                                   (mapm %store-monad
+                                         (lambda (hook)
+                                           (hook manifest))
+                                         hooks))))
     (define inputs
       (append (filter-map (lambda (drv)
                             (and (derivation? drv)
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 7733fbcae4..86e1eb115f 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -374,8 +374,8 @@ requisite store items i.e. the union closure of all the inputs."
        ((? direct-store-path? path)
         (list path)))))
 
-  (mlet %store-monad ((reqs (sequence %store-monad
-                                      (map input->requisites inputs))))
+  (mlet %store-monad ((reqs (mapm %store-monad
+                                  input->requisites inputs)))
     (return (delete-duplicates (concatenate reqs)))))
 
 (define (status->exit-code status)