mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-17 20:27:36 -05:00
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:
parent
e059adcb60
commit
ab37731a8d
1 changed files with 32 additions and 32 deletions
64
guix/ui.scm
64
guix/ui.scm
|
@ -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)
|
||||||
|
|
Loading…
Reference in a new issue