mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-25 20:19:18 -05: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:
parent
baf0a42882
commit
8cef92d063
2 changed files with 64 additions and 47 deletions
|
@ -20,6 +20,8 @@ (define-module (guix build profiles)
|
||||||
#:use-module (guix build union)
|
#:use-module (guix build union)
|
||||||
#:use-module (guix build utils)
|
#:use-module (guix build utils)
|
||||||
#:use-module (guix search-paths)
|
#:use-module (guix search-paths)
|
||||||
|
#:use-module (srfi srfi-1)
|
||||||
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (ice-9 ftw)
|
#:use-module (ice-9 ftw)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
|
@ -143,45 +145,71 @@ (define (unsymlink link)
|
||||||
directory))))
|
directory))))
|
||||||
(apply throw args))))))
|
(apply throw args))))))
|
||||||
|
|
||||||
(define* (build-profile output inputs
|
(define (manifest-sexp->inputs+search-paths manifest)
|
||||||
#:key manifest search-paths
|
"Parse MANIFEST, an sexp as produced by 'manifest->gexp', and return two
|
||||||
(symlink symlink))
|
values: the list of store items of its manifest entries, and the list of
|
||||||
"Build a user profile from INPUTS in directory OUTPUT, using SYMLINK to
|
search path specifications."
|
||||||
create symlinks. Write MANIFEST, an sexp, to OUTPUT/manifest. Create
|
(match manifest ;this must match 'manifest->gexp'
|
||||||
OUTPUT/etc/profile with Bash definitions for -all the variables listed in
|
(('manifest ('version 3)
|
||||||
SEARCH-PATHS."
|
('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
|
(define manifest-file
|
||||||
(string-append output "/manifest"))
|
(string-append output "/manifest"))
|
||||||
|
|
||||||
;; Make the symlinks.
|
(let-values (((inputs search-paths)
|
||||||
(union-build output inputs
|
(manifest-sexp->inputs+search-paths manifest)))
|
||||||
#:symlink symlink
|
|
||||||
#:log-port (%make-void-port "w"))
|
|
||||||
|
|
||||||
;; If one of the INPUTS provides a '/manifest' file, delete it. That can
|
;; Make the symlinks.
|
||||||
;; happen if MANIFEST contains something such as a Guix instance, which is
|
(union-build output (append extra-inputs inputs)
|
||||||
;; ultimately built as a profile.
|
#:symlink symlink
|
||||||
(when (file-exists? manifest-file)
|
#:log-port (%make-void-port "w"))
|
||||||
(delete-file manifest-file))
|
|
||||||
|
|
||||||
;; Store meta-data.
|
;; If one of the INPUTS provides a '/manifest' file, delete it. That can
|
||||||
(call-with-output-file manifest-file
|
;; happen if MANIFEST contains something such as a Guix instance, which is
|
||||||
(lambda (p)
|
;; ultimately built as a profile.
|
||||||
(display "\
|
(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.
|
;; This file was automatically generated and is for internal use only.
|
||||||
;; It cannot be passed to the '--manifest' option.
|
;; It cannot be passed to the '--manifest' option.
|
||||||
;; Run 'guix package --export-manifest' if you want to export a file
|
;; Run 'guix package --export-manifest' if you want to export a file
|
||||||
;; suitable for '--manifest'.\n\n"
|
;; suitable for '--manifest'.\n\n"
|
||||||
p)
|
p)
|
||||||
(pretty-print manifest p)))
|
(pretty-print manifest p)))
|
||||||
|
|
||||||
;; Make sure we can write to 'OUTPUT/etc'. 'union-build' above could have
|
;; 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
|
;; made 'etc' a symlink to a read-only sub-directory in the store so we
|
||||||
;; to work around that.
|
;; need to work around that.
|
||||||
(ensure-writable-directory (string-append output "/etc")
|
(ensure-writable-directory (string-append output "/etc")
|
||||||
#:symlink symlink)
|
#:symlink symlink)
|
||||||
|
|
||||||
;; Write 'OUTPUT/etc/profile'.
|
;; Write 'OUTPUT/etc/profile'.
|
||||||
(build-etc/profile output search-paths))
|
(build-etc/profile output search-paths)))
|
||||||
|
|
||||||
;;; profile.scm ends here
|
;;; profile.scm ends here
|
||||||
|
|
|
@ -1812,12 +1812,10 @@ (define* (profile-derivation manifest
|
||||||
(mapm/accumulate-builds (lambda (hook)
|
(mapm/accumulate-builds (lambda (hook)
|
||||||
(hook manifest))
|
(hook manifest))
|
||||||
hooks))))
|
hooks))))
|
||||||
(define inputs
|
(define extra-inputs
|
||||||
(append (filter-map (lambda (drv)
|
(filter-map (lambda (drv)
|
||||||
(and (derivation? drv)
|
(and (derivation? drv) (gexp-input drv)))
|
||||||
(gexp-input drv)))
|
extras))
|
||||||
extras)
|
|
||||||
(manifest-inputs manifest)))
|
|
||||||
|
|
||||||
(define glibc-utf8-locales ;lazy reference
|
(define glibc-utf8-locales ;lazy reference
|
||||||
(module-ref (resolve-interface '(gnu packages base))
|
(module-ref (resolve-interface '(gnu packages base))
|
||||||
|
@ -1851,20 +1849,11 @@ (define builder
|
||||||
|
|
||||||
#+(if locales? set-utf8-locale #t)
|
#+(if locales? set-utf8-locale #t)
|
||||||
|
|
||||||
(define search-paths
|
(build-profile #$output '#$(manifest->gexp manifest)
|
||||||
;; Search paths of MANIFEST's packages, converted back to their
|
#:extra-inputs '#$extra-inputs
|
||||||
;; record form.
|
|
||||||
(map sexp->search-path-specification
|
|
||||||
(delete-duplicates
|
|
||||||
'#$(map search-path-specification->sexp
|
|
||||||
(manifest-search-paths manifest)))))
|
|
||||||
|
|
||||||
(build-profile #$output '#$inputs
|
|
||||||
#:symlink #$(if relative-symlinks?
|
#:symlink #$(if relative-symlinks?
|
||||||
#~symlink-relative
|
#~symlink-relative
|
||||||
#~symlink)
|
#~symlink)))))
|
||||||
#:manifest '#$(manifest->gexp manifest)
|
|
||||||
#:search-paths search-paths))))
|
|
||||||
|
|
||||||
(gexp->derivation name builder
|
(gexp->derivation name builder
|
||||||
#:system system
|
#:system system
|
||||||
|
|
Loading…
Reference in a new issue