3
5
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00

profiles: Move some of the work to the build side.

When running:

  guix environment --ad-hoc gnome --no-grafts --search-paths

this reduces wall-clock time by ~5%.  The number of object cache lookups
goes down from 96K to 89K.  (Note that 'gnome' is an interesting example
because it has many propagated inputs, which themselves have propagated
inputs too, which would lead to a long input list and a long manifest in
the 'profile-derivation' gexp.)

* guix/profiles.scm (profile-derivation)[inputs, search-paths]: Remove.
[extra-inputs]: New variable.
[builder]: Adjust call to 'build-profile'.
* guix/build/profiles.scm (manifest-sexp->inputs+search-paths): New
procedure.
(build-profile): Remove 'inputs' parameter; make 'manifest' the 2nd
positional parameter and add #:extra-inputs.  Call
'manifest-sexp->inputs+search-paths' to obtain 'inputs' and
'search-paths'.
This commit is contained in:
Ludovic Courtès 2021-06-05 22:47:10 +02:00
parent baf0a42882
commit 8cef92d063
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 64 additions and 47 deletions

View file

@ -20,6 +20,8 @@
#:use-module (guix build union)
#:use-module (guix build utils)
#:use-module (guix search-paths)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
@ -143,45 +145,71 @@ instead make DIRECTORY a \"real\" directory containing symlinks."
directory))))
(apply throw args))))))
(define* (build-profile output inputs
#:key manifest search-paths
(symlink symlink))
"Build a user profile from INPUTS in directory OUTPUT, using SYMLINK to
create symlinks. Write MANIFEST, an sexp, to OUTPUT/manifest. Create
OUTPUT/etc/profile with Bash definitions for -all the variables listed in
SEARCH-PATHS."
(define (manifest-sexp->inputs+search-paths manifest)
"Parse MANIFEST, an sexp as produced by 'manifest->gexp', and return two
values: the list of store items of its manifest entries, and the list of
search path specifications."
(match manifest ;this must match 'manifest->gexp'
(('manifest ('version 3)
('packages (entries ...)))
(let loop ((entries entries)
(inputs '())
(search-paths '()))
(match entries
(((name version output item
('propagated-inputs deps)
('search-paths paths) _ ...) . rest)
(loop (append deps rest)
(cons item inputs)
(append paths search-paths)))
(()
(values inputs
(delete-duplicates
(cons $PATH
(map sexp->search-path-specification
search-paths))))))))))
(define* (build-profile output manifest
#:key (extra-inputs '()) (symlink symlink))
"Build a user profile from MANIFEST, an sexp, and EXTRA-INPUTS, a list of
store items, in directory OUTPUT, using SYMLINK to create symlinks. Create
OUTPUT/etc/profile with Bash definitions for all the variables listed in the
search paths of MANIFEST's entries."
(define manifest-file
(string-append output "/manifest"))
;; Make the symlinks.
(union-build output inputs
#:symlink symlink
#:log-port (%make-void-port "w"))
(let-values (((inputs search-paths)
(manifest-sexp->inputs+search-paths manifest)))
;; If one of the INPUTS provides a '/manifest' file, delete it. That can
;; happen if MANIFEST contains something such as a Guix instance, which is
;; ultimately built as a profile.
(when (file-exists? manifest-file)
(delete-file manifest-file))
;; Make the symlinks.
(union-build output (append extra-inputs inputs)
#:symlink symlink
#:log-port (%make-void-port "w"))
;; Store meta-data.
(call-with-output-file manifest-file
(lambda (p)
(display "\
;; If one of the INPUTS provides a '/manifest' file, delete it. That can
;; happen if MANIFEST contains something such as a Guix instance, which is
;; ultimately built as a profile.
(when (file-exists? manifest-file)
(delete-file manifest-file))
;; Store meta-data.
(call-with-output-file manifest-file
(lambda (p)
(display "\
;; This file was automatically generated and is for internal use only.
;; It cannot be passed to the '--manifest' option.
;; Run 'guix package --export-manifest' if you want to export a file
;; suitable for '--manifest'.\n\n"
p)
(pretty-print manifest p)))
p)
(pretty-print manifest p)))
;; Make sure we can write to 'OUTPUT/etc'. 'union-build' above could have
;; made 'etc' a symlink to a read-only sub-directory in the store so we need
;; to work around that.
(ensure-writable-directory (string-append output "/etc")
#:symlink symlink)
;; Make sure we can write to 'OUTPUT/etc'. 'union-build' above could have
;; made 'etc' a symlink to a read-only sub-directory in the store so we
;; need to work around that.
(ensure-writable-directory (string-append output "/etc")
#:symlink symlink)
;; Write 'OUTPUT/etc/profile'.
(build-etc/profile output search-paths))
;; Write 'OUTPUT/etc/profile'.
(build-etc/profile output search-paths)))
;;; profile.scm ends here

View file

@ -1812,12 +1812,10 @@ are cross-built for TARGET."
(mapm/accumulate-builds (lambda (hook)
(hook manifest))
hooks))))
(define inputs
(append (filter-map (lambda (drv)
(and (derivation? drv)
(gexp-input drv)))
extras)
(manifest-inputs manifest)))
(define extra-inputs
(filter-map (lambda (drv)
(and (derivation? drv) (gexp-input drv)))
extras))
(define glibc-utf8-locales ;lazy reference
(module-ref (resolve-interface '(gnu packages base))
@ -1851,20 +1849,11 @@ are cross-built for TARGET."
#+(if locales? set-utf8-locale #t)
(define search-paths
;; Search paths of MANIFEST's packages, converted back to their
;; record form.
(map sexp->search-path-specification
(delete-duplicates
'#$(map search-path-specification->sexp
(manifest-search-paths manifest)))))
(build-profile #$output '#$inputs
(build-profile #$output '#$(manifest->gexp manifest)
#:extra-inputs '#$extra-inputs
#:symlink #$(if relative-symlinks?
#~symlink-relative
#~symlink)
#:manifest '#$(manifest->gexp manifest)
#:search-paths search-paths))))
#~symlink)))))
(gexp->derivation name builder
#:system system