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 dcb95c1fc9
.
* 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.
This commit is contained in:
parent
73b0ebdd5e
commit
b334674fe5
|
@ -566,15 +566,15 @@ list."
|
||||||
corresponding input list as a monadic value. When TARGET is true, use it as
|
corresponding input list as a monadic value. When TARGET is true, use it as
|
||||||
the cross-compilation target triplet."
|
the cross-compilation target triplet."
|
||||||
(with-monad %store-monad
|
(with-monad %store-monad
|
||||||
(sequence %store-monad
|
(mapm %store-monad
|
||||||
(map (match-lambda
|
(match-lambda
|
||||||
(((? struct? thing) sub-drv ...)
|
(((? struct? thing) sub-drv ...)
|
||||||
(mlet %store-monad ((drv (lower-object
|
(mlet %store-monad ((drv (lower-object
|
||||||
thing system #:target target)))
|
thing system #:target target)))
|
||||||
(return `(,drv ,@sub-drv))))
|
(return `(,drv ,@sub-drv))))
|
||||||
(input
|
(input
|
||||||
(return input)))
|
(return input)))
|
||||||
inputs))))
|
inputs)))
|
||||||
|
|
||||||
(define* (lower-reference-graphs graphs #:key system target)
|
(define* (lower-reference-graphs graphs #:key system target)
|
||||||
"Given GRAPHS, a list of (FILE-NAME INPUT ...) lists for use as a
|
"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)))
|
#:target target)))
|
||||||
(return (derivation->output-path drv))))))
|
(return (derivation->output-path drv))))))
|
||||||
|
|
||||||
(sequence %store-monad (map lower lst))))
|
(mapm %store-monad lower lst)))
|
||||||
|
|
||||||
(define default-guile-derivation
|
(define default-guile-derivation
|
||||||
;; Here we break the abstraction by talking to the higher-level layer.
|
;; 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
|
#:system system
|
||||||
#:target (if (or n? native?) #f target)))
|
#:target (if (or n? native?) #f target)))
|
||||||
(($ <gexp-input> (refs ...) output n?)
|
(($ <gexp-input> (refs ...) output n?)
|
||||||
(sequence %store-monad
|
(mapm %store-monad
|
||||||
(map (lambda (ref)
|
(lambda (ref)
|
||||||
;; XXX: Automatically convert REF to an gexp-input.
|
;; XXX: Automatically convert REF to an gexp-input.
|
||||||
(reference->sexp
|
(reference->sexp
|
||||||
(if (gexp-input? ref)
|
(if (gexp-input? ref)
|
||||||
ref
|
ref
|
||||||
(%gexp-input ref "out" n?))
|
(%gexp-input ref "out" n?))
|
||||||
(or n? native?)))
|
(or n? native?)))
|
||||||
refs)))
|
refs))
|
||||||
(($ <gexp-input> (? struct? thing) output n?)
|
(($ <gexp-input> (? struct? thing) output n?)
|
||||||
(let ((target (if (or n? native?) #f target))
|
(let ((target (if (or n? native?) #f target))
|
||||||
(expand (lookup-expander thing)))
|
(expand (lookup-expander thing)))
|
||||||
|
@ -902,8 +902,8 @@ and in the current monad setting (system type, etc.)"
|
||||||
(return x)))))
|
(return x)))))
|
||||||
|
|
||||||
(mlet %store-monad
|
(mlet %store-monad
|
||||||
((args (sequence %store-monad
|
((args (mapm %store-monad
|
||||||
(map reference->sexp (gexp-references exp)))))
|
reference->sexp (gexp-references exp))))
|
||||||
(return (apply (gexp-proc exp) args))))
|
(return (apply (gexp-proc exp) args))))
|
||||||
|
|
||||||
(define (syntax-location-string s)
|
(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)))
|
(mlet %store-monad ((file (lower-object file-like system)))
|
||||||
(return (list final-path file))))))
|
(return (list final-path file))))))
|
||||||
|
|
||||||
(mlet %store-monad ((files (sequence %store-monad
|
(mlet %store-monad ((files (mapm %store-monad file-pair files)))
|
||||||
(map file-pair files))))
|
|
||||||
(define build
|
(define build
|
||||||
(gexp
|
(gexp
|
||||||
(begin
|
(begin
|
||||||
|
|
|
@ -1383,10 +1383,10 @@ are cross-built for TARGET."
|
||||||
#:target target)))
|
#:target target)))
|
||||||
(extras (if (null? (manifest-entries manifest))
|
(extras (if (null? (manifest-entries manifest))
|
||||||
(return '())
|
(return '())
|
||||||
(sequence %store-monad
|
(mapm %store-monad
|
||||||
(map (lambda (hook)
|
(lambda (hook)
|
||||||
(hook manifest))
|
(hook manifest))
|
||||||
hooks)))))
|
hooks))))
|
||||||
(define inputs
|
(define inputs
|
||||||
(append (filter-map (lambda (drv)
|
(append (filter-map (lambda (drv)
|
||||||
(and (derivation? drv)
|
(and (derivation? drv)
|
||||||
|
|
|
@ -374,8 +374,8 @@ requisite store items i.e. the union closure of all the inputs."
|
||||||
((? direct-store-path? path)
|
((? direct-store-path? path)
|
||||||
(list path)))))
|
(list path)))))
|
||||||
|
|
||||||
(mlet %store-monad ((reqs (sequence %store-monad
|
(mlet %store-monad ((reqs (mapm %store-monad
|
||||||
(map input->requisites inputs))))
|
input->requisites inputs)))
|
||||||
(return (delete-duplicates (concatenate reqs)))))
|
(return (delete-duplicates (concatenate reqs)))))
|
||||||
|
|
||||||
(define (status->exit-code status)
|
(define (status->exit-code status)
|
||||||
|
|
Loading…
Reference in New Issue