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,16 +2139,14 @@ (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. (dynamic-wind
(with-fluids ((%file-port-name-canonicalization #f)) (const #f)
(dynamic-wind (lambda ()
(const #f) (apply command-main args))
(lambda () (lambda ()
(apply command-main args)) ;; Abuse 'exit-hook' (which is normally meant to be used by the
(lambda () ;; REPL) to run things like profiling hooks upon completion.
;; Abuse 'exit-hook' (which is normally meant to be used by the (run-hook exit-hook))))))
;; REPL) to run things like profiling hooks upon completion.
(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,28 +2158,30 @@ (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"))
(match args ;; Disable canonicalization so we don't don't stat unreasonably.
(() (with-fluids ((%file-port-name-canonicalization #f))
(format (current-error-port) (match args
(G_ "guix: missing command name~%")) (()
(show-guix-usage)) (format (current-error-port)
((or ("-h") ("--help")) (G_ "guix: missing command name~%"))
(leave-on-EPIPE (show-guix-help))) (show-guix-usage))
((or ("-V") ("--version")) ((or ("-h") ("--help"))
(show-version-and-exit "guix")) (leave-on-EPIPE (show-guix-help)))
(((? option? o) args ...) ((or ("-V") ("--version"))
(format (current-error-port) (show-version-and-exit "guix"))
(G_ "guix: unrecognized option '~a'~%") o) (((? option? o) args ...)
(show-guix-usage)) (format (current-error-port)
(("help" command) (G_ "guix: unrecognized option '~a'~%") o)
(apply run-guix-command (string->symbol command) (show-guix-usage))
'("--help"))) (("help" command)
(("help" args ...) (apply run-guix-command (string->symbol command)
(leave-on-EPIPE (show-guix-help))) '("--help")))
((command args ...) (("help" args ...)
(apply run-guix-command (leave-on-EPIPE (show-guix-help)))
(string->symbol command) ((command args ...)
args)))) (apply run-guix-command
(string->symbol command)
args)))))
(define (guix-main arg0 . args) (define (guix-main arg0 . args)
(initialize-guix) (initialize-guix)