ui: Have 'guix help' stat less.

This reduces the number of syscalls for:

  env -i $(type -P strace) -c $(type -P guix) help

from 4.3K to 2.2K, thereby reducing startup time.

Reported by Julien Lepiller.

* guix/ui.scm (run-guix-command): Move %FILE-PORT-NAME-CANONICALIZATION
to...
(run-guix): ... here.
This commit is contained in:
Ludovic Courtès 2021-06-28 22:52:16 +02:00
parent e059adcb60
commit ab37731a8d
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -2139,8 +2139,6 @@ (define module
(let ((command-main (module-ref module (let ((command-main (module-ref module
(symbol-append 'guix- command)))) (symbol-append 'guix- command))))
(parameterize ((program-name command)) (parameterize ((program-name command))
;; Disable canonicalization so we don't don't stat unreasonably.
(with-fluids ((%file-port-name-canonicalization #f))
(dynamic-wind (dynamic-wind
(const #f) (const #f)
(lambda () (lambda ()
@ -2148,7 +2146,7 @@ (define module
(lambda () (lambda ()
;; Abuse 'exit-hook' (which is normally meant to be used by the ;; Abuse 'exit-hook' (which is normally meant to be used by the
;; REPL) to run things like profiling hooks upon completion. ;; REPL) to run things like profiling hooks upon completion.
(run-hook exit-hook))))))) (run-hook exit-hook))))))
(define (run-guix . args) (define (run-guix . args)
"Run the 'guix' command defined by command line ARGS. "Run the 'guix' command defined by command line ARGS.
@ -2160,6 +2158,8 @@ (define option? (cut string-prefix? "-" <>))
;; number of 'stat' calls per entry in %LOAD-PATH. Shamelessly remove it. ;; number of 'stat' calls per entry in %LOAD-PATH. Shamelessly remove it.
(set! %load-extensions '(".scm")) (set! %load-extensions '(".scm"))
;; Disable canonicalization so we don't don't stat unreasonably.
(with-fluids ((%file-port-name-canonicalization #f))
(match args (match args
(() (()
(format (current-error-port) (format (current-error-port)
@ -2181,7 +2181,7 @@ (define option? (cut string-prefix? "-" <>))
((command args ...) ((command args ...)
(apply run-guix-command (apply run-guix-command
(string->symbol command) (string->symbol command)
args)))) args)))))
(define (guix-main arg0 . args) (define (guix-main arg0 . args)
(initialize-guix) (initialize-guix)