gexp: 'gexp->script' does not emit load-path expression when unnecessary.

This removes two elements from %LOAD-PATH and %LOAD-COMPILED-PATH of the
'guix' command and thus further reduces the number of 'stat' calls it
makes.

* guix/gexp.scm (load-path-expression): Return #f when MODULES and
EXTENSIONS are both empty.
(gexp->script): Don't emit anything when SET-LOAD-PATH is #f.
This commit is contained in:
Ludovic Courtès 2019-01-07 23:45:15 +01:00
parent 49c35bbb71
commit efff32452a
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -1315,30 +1315,33 @@ (define* (load-path-expression modules #:optional (path %load-path)
#:key (extensions '())) #:key (extensions '()))
"Return as a monadic value a gexp that sets '%load-path' and "Return as a monadic value a gexp that sets '%load-path' and
'%load-compiled-path' to point to MODULES, a list of module names. MODULES '%load-compiled-path' to point to MODULES, a list of module names. MODULES
are searched for in PATH." are searched for in PATH. Return #f when MODULES and EXTENSIONS are empty."
(mlet %store-monad ((modules (imported-modules modules (if (and (null? modules) (null? extensions))
#:module-path path)) (with-monad %store-monad
(compiled (compiled-modules modules (return #f))
#:extensions extensions (mlet %store-monad ((modules (imported-modules modules
#:module-path path))) #:module-path path))
(return (gexp (eval-when (expand load eval) (compiled (compiled-modules modules
(set! %load-path #:extensions extensions
(cons (ungexp modules) #:module-path path)))
(append (map (lambda (extension) (return (gexp (eval-when (expand load eval)
(string-append extension (set! %load-path
"/share/guile/site/" (cons (ungexp modules)
(effective-version))) (append (map (lambda (extension)
'((ungexp-native-splicing extensions))) (string-append extension
%load-path))) "/share/guile/site/"
(set! %load-compiled-path (effective-version)))
(cons (ungexp compiled) '((ungexp-native-splicing extensions)))
(append (map (lambda (extension) %load-path)))
(string-append extension (set! %load-compiled-path
"/lib/guile/" (cons (ungexp compiled)
(effective-version) (append (map (lambda (extension)
"/site-ccache")) (string-append extension
'((ungexp-native-splicing extensions))) "/lib/guile/"
%load-compiled-path)))))))) (effective-version)
"/site-ccache"))
'((ungexp-native-splicing extensions)))
%load-compiled-path)))))))))
(define* (gexp->script name exp (define* (gexp->script name exp
#:key (guile (default-guile)) #:key (guile (default-guile))
@ -1362,7 +1365,11 @@ (define* (gexp->script name exp
"#!~a/bin/guile --no-auto-compile~%!#~%" "#!~a/bin/guile --no-auto-compile~%!#~%"
(ungexp guile)) (ungexp guile))
(write '(ungexp set-load-path) port) (ungexp-splicing
(if set-load-path
(gexp ((write '(ungexp set-load-path) port)))
(gexp ())))
(write '(ungexp exp) port) (write '(ungexp exp) port)
(chmod port #o555)))) (chmod port #o555))))
#:module-path module-path))) #:module-path module-path)))