From 4ff12d1de7cd617b791996ee7ca1240660b4c20e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 31 May 2022 17:17:10 +0200 Subject: profiles: Do not repeat entries in 'manifest' file. Fixes . Reported by Ricardo Wurmus . With this change, the manifest file created for: guix install r r-seurat r-cistopic r-monocle3 r-cicero-monocle3 r-assertthat goes from 5.7M to 176K. Likewise, on this profile, wall-clock time of: GUIX_PROFILING=gc guix package -I goes from 0.7s to 0.1s, with heap usage going from 55M to 9M. * guix/profiles.scm (manifest->gexp)[optional]: New procedure. [entry->gexp]: Turn into a monadic procedure. Return a 'repeated' sexp if ENTRY was already visited before. Adjust caller accordingly. Bump manifest version. (sexp->manifest)[sexp->manifest-entry]: Turn into a monadic procedure. Add case for 'repeated' nodes. Add each entry to the current state vhash. Add clause for version 4 manifests. [sexp->manifest-entry/v3]: New procedure, with former 'sexp->manifest-entry' code. * tests/profiles.scm ("deduplication of repeated entries"): New test. * guix/build/profiles.scm (manifest-sexp->inputs+search-paths)[let-fields]: New macro. Use it. Expect version 4. Add clause for 'repeated' nodes. --- guix/build/profiles.scm | 32 +++++++++++++++++++++++++------- 1 file changed, 25 insertions(+), 7 deletions(-) (limited to 'guix/build') diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm index f9875ca92e..2ab76bde74 100644 --- a/guix/build/profiles.scm +++ b/guix/build/profiles.scm @@ -149,19 +149,33 @@ instead make DIRECTORY a \"real\" directory containing symlinks." "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." + (define-syntax let-fields + (syntax-rules () + ;; Bind the fields NAME of LST to same-named variables in the lexical + ;; scope of BODY. + ((_ lst (name rest ...) body ...) + (let ((name (match (assq 'name lst) + ((_ value) value) + (#f '())))) + (let-fields lst (rest ...) body ...))) + ((_ lst () body ...) + (begin body ...)))) + (match manifest ;this must match 'manifest->gexp' - (('manifest ('version 3) + (('manifest ('version 4) ('packages (entries ...))) (let loop ((entries entries) (inputs '()) (search-paths '())) (match entries - (((name version output item - ('propagated-inputs deps) - ('search-paths paths) _ ...) . rest) - (loop (append rest deps) ;breadth-first traversal - (cons item inputs) - (append paths search-paths))) + (((name version output item fields ...) . rest) + (let ((paths search-paths)) + (let-fields fields (propagated-inputs search-paths properties) + (loop (append rest propagated-inputs) ;breadth-first traversal + (cons item inputs) + (append search-paths paths))))) + ((('repeated name version item) . rest) + (loop rest inputs search-paths)) (() (values (reverse inputs) (delete-duplicates @@ -212,4 +226,8 @@ search paths of MANIFEST's entries." ;; Write 'OUTPUT/etc/profile'. (build-etc/profile output search-paths))) +;;; Local Variables: +;;; eval: (put 'let-fields 'scheme-indent-function 2) +;;; End: + ;;; profile.scm ends here -- cgit v1.2.3