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
3 changed files with 28 additions and 29 deletions
|
@ -566,15 +566,15 @@ (define* (lower-inputs inputs
|
|||
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 @@ (define lower
|
|||
#: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 @@ (define* (reference->sexp ref #:optional native?)
|
|||
#: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 @@ (define* (reference->sexp ref #:optional native?)
|
|||
(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 @@ (define file-pair
|
|||
(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
|
||||
|
|
|
@ -1383,10 +1383,10 @@ (define* (profile-derivation manifest
|
|||
#: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)
|
||||
|
|
|
@ -374,8 +374,8 @@ (define (input->requisites input)
|
|||
((? 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)
|
||||
|
|
Loading…
Reference in a new issue