civodul pushed a commit to branch wip-build-systems-gexp in repository guix.
commit 194c292929b0dcf188df288b8d7da4b1f1b12a32 Author: Ludovic Courtès <[email protected]> Date: Sun Jun 25 15:33:58 2017 +0200 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 | 35 +++++++++++++++++------------------ guix/profiles.scm | 8 ++++---- guix/scripts/environment.scm | 4 ++-- guix/scripts/system.scm | 6 +++--- 4 files changed, 26 insertions(+), 27 deletions(-) diff --git a/guix/gexp.scm b/guix/gexp.scm index d30769e..93172f5 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -490,15 +490,15 @@ false, meaning that GEXP is a plain Scheme object, return the empty 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 @@ -530,7 +530,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. @@ -771,10 +771,10 @@ 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) - (reference->sexp ref (or n? native?))) - refs))) + (mapm %store-monad + (lambda (ref) + (reference->sexp ref (or n? native?))) + refs)) (($ <gexp-input> (? struct? thing) output n?) (let ((target (if (or n? native?) #f target)) (expand (lookup-expander thing))) @@ -788,8 +788,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) @@ -959,8 +959,7 @@ as returned by 'local-file' for example." (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 6733f10..5a09c24 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -1064,10 +1064,10 @@ are cross-built for TARGET." (current-system))) (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 af69e2b..8f440fe 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -343,8 +343,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) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 35675cc..dbc84c1 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -143,9 +143,9 @@ TARGET, and register them." (to-copy (topologically-sorted* (delete-duplicates (cons item refs) string=?)))) - (sequence %store-monad - (map (cut copy-item <> target #:log-port log-port) - to-copy)))) + (mapm %store-monad + (cut copy-item <> target #:log-port log-port) + to-copy))) (define* (install-bootloader installer-drv #:key
