mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-31 06:46:50 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

gexp: Micro-optimize 'gexp->sexp' and 'lower-inputs'.

Browse source 
* guix/gexp.scm (lower-inputs, gexp->sexp): Change keyword parameters to
positional parameters.  Adjust callers accordingly.
* tests/gexp.scm (gexp->sexp*, "gexp->file"): Adjust accordingly.
This commit is contained in:
Ludovic Courtès 2021-02-17 14:25:43 +01:00
parent a26006ff72
commit b57de6fea1
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 8 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
guix/gexp.scm
View file

@ -826,8 +826,7 @@ (define (self-quoting? x)
(one-of symbol? string? keyword? pair? null? array? (one-of symbol? string? keyword? pair? null? array?
number? boolean? char?))) number? boolean? char?)))
(define* (lower-inputs inputs (define (lower-inputs inputs system target)
#:key system target)
"Turn any object from INPUTS into a derivation input for SYSTEM or a store "Turn any object from INPUTS into a derivation input for SYSTEM or a store
item (a \"source\"); return the corresponding input list as a monadic value. item (a \"source\"); return the corresponding input list as a monadic value.
When TARGET is true, use it as the cross-compilation target triplet." When TARGET is true, use it as the cross-compilation target triplet."
@ -874,8 +873,7 @@ (define tuple->gexp-input
(match graphs (match graphs
(((file-names . inputs) ...) (((file-names . inputs) ...)
(mlet %store-monad ((inputs (lower-inputs (map tuple->gexp-input inputs) (mlet %store-monad ((inputs (lower-inputs (map tuple->gexp-input inputs)
#:system system system target)))
#:target target)))
(return (map cons file-names inputs)))))) (return (map cons file-names inputs))))))
(define* (lower-references lst #:key system target) (define* (lower-references lst #:key system target)
@ -1005,11 +1003,8 @@ (define (search-path modules extensions suffix)
(return guile-for-build) (return guile-for-build)
(default-guile-derivation system))) (default-guile-derivation system)))
(inputs (lower-inputs (gexp-inputs exp) (inputs (lower-inputs (gexp-inputs exp)
#:system system system target))
#:target target)) (sexp (gexp->sexp exp system target))
(sexp (gexp->sexp exp
#:system system
#:target target))
(extensions -> (gexp-extensions exp)) (extensions -> (gexp-extensions exp))
(exts (mapm %store-monad (exts (mapm %store-monad
(lambda (obj) (lambda (obj)
@ -1278,9 +1273,7 @@ (define (add-reference-output ref result)
(delete-duplicates (delete-duplicates
(add-reference-output (gexp-references exp) '()))) (add-reference-output (gexp-references exp) '())))
(define* (gexp->sexp exp #:key (define (gexp->sexp exp system target)
(system (%current-system))
(target (%current-target-system)))
"Return (monadically) the sexp corresponding to EXP for the given OUTPUT, "Return (monadically) the sexp corresponding to EXP for the given OUTPUT,
and in the current monad setting (system type, etc.)" and in the current monad setting (system type, etc.)"
(define* (reference->sexp ref #:optional native?) (define* (reference->sexp ref #:optional native?)
@ -1293,8 +1286,7 @@ (define* (reference->sexp ref #:optional native?)
(return `((@ (guile) getenv) ,output))) (return `((@ (guile) getenv) ,output)))
(($ <gexp-input> (? gexp? exp) output n?) (($ <gexp-input> (? gexp? exp) output n?)
(gexp->sexp exp (gexp->sexp exp
#:system system system (if (or n? native?) #f target)))
#:target (if (or n? native?) #f target)))
(($ <gexp-input> (refs ...) output n?) (($ <gexp-input> (refs ...) output n?)
(mapm %store-monad (mapm %store-monad
(lambda (ref) (lambda (ref)

5
tests/gexp.scm
View file

@ -57,8 +57,7 @@ (define (gexp->sexp . x)
(apply (@@ (guix gexp) gexp->sexp) x)) (apply (@@ (guix gexp) gexp->sexp) x))
(define* (gexp->sexp* exp #:optional target) (define* (gexp->sexp* exp #:optional target)
(run-with-store %store (gexp->sexp exp (run-with-store %store (gexp->sexp exp (%current-system) target)
#:target target)
#:guile-for-build (%guile-for-build))) #:guile-for-build (%guile-for-build)))
(define (gexp-input->tuple input) (define (gexp-input->tuple input)
@ -540,7 +539,7 @@ (define (match-input thing)
(test-assertm "gexp->file" (test-assertm "gexp->file"
(mlet* %store-monad ((exp -> (gexp (display (ungexp %bootstrap-guile)))) (mlet* %store-monad ((exp -> (gexp (display (ungexp %bootstrap-guile))))
(guile (package-file %bootstrap-guile)) (guile (package-file %bootstrap-guile))
(sexp (gexp->sexp exp)) (sexp (gexp->sexp exp (%current-system) #f))
(drv (gexp->file "foo" exp)) (drv (gexp->file "foo" exp))
(out -> (derivation->output-path drv)) (out -> (derivation->output-path drv))
(done (built-derivations (list drv))) (done (built-derivations (list drv)))