Full log Message #10 received at 41702@debbugs.gnu.org (full text , mbox , reply ):
[Message part 1 (text/plain, inline)]
Hi,
Lars-Dominik Braun <ldb@leibniz-psychology.org> skribis:
> Total time: 24.672604202 seconds (19.431122691 seconds in GC)
> ./pre-inst-env guix environment --ad-hoc r-learnr -- true 25,18s user 0,24s system 308% cpu 8,248 total
>
> More specifically in an anonymous function and reap-pipes, which is a gc hook,
> I believe:
>
> % cumulative self
> time seconds seconds calls procedure
> 33.41 14.49 8.24 anon #xbb8480
> 27.95 6.90 6.90 ice-9/popen.scm:145:0:reap-pipes
> 4.37 1.08 1.08 anon #xbbdcd8
> 3.28 0.86 0.81 ice-9/vlist.scm:539:0:vhash-assq
> 2.40 2.37 0.59 guix/grafts.scm:202:22
Guile master has a fix for statprof that yields more useful info:
--8<---------------cut here---------------start------------->8---
scheme@(guile-user)> ,use(guix scripts environment)
scheme@(guile-user)> ,pr (guix-environment "--ad-hoc" "r-learnr" "--" "true")
% cumulative self
time seconds seconds procedure
29.84 9.87 6.16 append
19.56 4.04 4.04 %after-gc-thunk
6.85 1.87 1.42 ice-9/vlist.scm:539:0:vhash-assq
5.44 1.17 1.12 write
3.23 0.67 0.67 guix/derivations.scm:665:0:derivation->output-paths
2.82 0.58 0.58 string=?
2.42 2.37 0.50 guix/grafts.scm:202:22
2.42 0.50 0.50 list?
2.22 0.46 0.46 hashq
2.02 0.42 0.42 display
1.61 15.82 0.33 guix/grafts.scm:186:0:reference-origin
1.61 0.87 0.33 guix/grafts.scm:204:31
1.21 0.33 0.25 guix/derivations.scm:667:7
1.21 0.29 0.25 srfi/srfi-1.scm:817:0:any
1.01 1232.14 0.21 srfi/srfi-1.scm:584:5:map1
0.81 0.83 0.17 guix/derivations.scm:697:0:derivation/masked-inputs
0.81 0.75 0.17 srfi/srfi-1.scm:580:2:map
0.81 0.17 0.17 guix/derivations.scm:158:0:%derivation-input-derivation-procedure
0.60 0.17 0.12 reverse
0.60 0.12 0.12 hashq-ref
0.60 0.12 0.12 get-bytevector-n
0.60 0.12 0.12 procedure?
0.40 0.67 0.08 guix/packages.scm:1232:0:fold-bag-dependencies
0.40 0.12 0.08 string->utf8
0.40 0.12 0.08 ice-9/vlist.scm:534:0:vhash-assoc
0.40 0.12 0.08 ice-9/vlist.scm:449:0:vhash-cons
0.40 0.12 0.08 delete-duplicates
0.40 0.08 0.08 ice-9/boot-9.scm:1389:0:->bool
0.40 0.08 0.08 ice-9/boot-9.scm:2201:0:%load-announce
0.40 0.08 0.08 hash
0.40 0.08 0.08 guix/derivations.scm:665:0:derivation->output-paths
0.20 20.73 0.04 guix/gexp.scm:1061:2
--8<---------------cut here---------------end--------------->8---
Notice that the same command with ‘--no-grafts’ takes 2s instead of 11s.
The patch below arranges so that ‘cumulative-grafts’ processes
dependencies in a batch, such that the derivation’s dependency graph is
traversed once for all, which makes a difference for derivations with
lots of inputs.
Here’s the before/after comparison:
--8<---------------cut here---------------start------------->8---
$ time guix environment --ad-hoc r-learnr --search-paths
export PATH="/gnu/store/n4wxbmqpafjfyawrla8xymzzdm5hxwph-profile/bin${PATH:+:}$PATH"
real 0m11.328s
user 0m20.155s
sys 0m0.172s
$ time ./pre-inst-env guix environment --ad-hoc r-learnr --search-paths
export PATH="/gnu/store/if6z77la3mx0qdzvcyl4qv9i5cyp48i0-profile/bin${PATH:+:}$PATH"
real 0m4.602s
user 0m6.189s
sys 0m0.136s
--8<---------------cut here---------------end--------------->8---
There’s still room for improvement, but it’s much better.
Ludo’.
[Message part 2 (text/x-patch, inline)]
diff --git a/guix/grafts.scm b/guix/grafts.scm
index 69d6fe4469..910dcadc8a 100644
--- a/guix/grafts.scm
+++ b/guix/grafts.scm
@@ -20,10 +20,12 @@
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix records)
+ #:use-module (guix combinators)
#:use-module (guix derivations)
#:use-module ((guix utils) #:select (%current-system))
#:use-module (guix sets)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
@@ -183,32 +185,47 @@ references."
(set-current-state (vhash-cons key result cache))
(return result)))))))
-(define (reference-origin drv item)
- "Return the derivation/output pair among the inputs of DRV, recursively,
-that produces ITEM. Return #f if ITEM is not produced by a derivation (i.e.,
-it's a content-addressed \"source\"), or if it's not produced by a dependency
-of DRV."
+(define (reference-origins drv items)
+ "Return the derivation/output pairs among the inputs of DRV, recursively,
+that produce ITEMS. Elements of ITEMS not produced by a derivation (i.e.,
+it's a content-addressed \"source\"), or not produced by a dependency of DRV,
+have no corresponding element in the resulting list."
+ (define (lookup-derivers drv result items)
+ ;; Return RESULT augmented by all the drv/output pairs producing one of
+ ;; ITEMS, and ITEMS stripped of matching items.
+ (fold2 (match-lambda*
+ (((output . file) result items)
+ (if (member file items)
+ (values (alist-cons drv output result)
+ (delete file items))
+ (values result items))))
+ result items
+ (derivation->output-paths drv)))
+
;; Perform a breadth-first traversal of the dependency graph of DRV in
- ;; search of the derivation that produces ITEM.
+ ;; search of the derivations that produce ITEMS.
(let loop ((drv (list drv))
+ (items items)
+ (result '())
(visited (setq)))
(match drv
(()
- #f)
+ result)
((drv . rest)
- (if (set-contains? visited drv)
- (loop rest visited)
- (let ((inputs (derivation-inputs drv)))
- (or (any (lambda (input)
- (let ((drv (derivation-input-derivation input)))
- (any (match-lambda
- ((output . file)
- (and (string=? file item)
- (cons drv output))))
- (derivation->output-paths drv))))
- inputs)
- (loop (append rest (map derivation-input-derivation inputs))
- (set-insert drv visited)))))))))
+ (cond ((null? items)
+ result)
+ ((set-contains? visited drv)
+ (loop rest items result visited))
+ (else
+ (let*-values (((inputs)
+ (map derivation-input-derivation
+ (derivation-inputs drv)))
+ ((result items)
+ (fold2 lookup-derivers
+ result items inputs)))
+ (loop (append rest inputs)
+ items result
+ (set-insert drv visited)))))))))
(define* (cumulative-grafts store drv grafts
#:key
@@ -233,25 +250,27 @@ derivations to the corresponding set of grafts."
(_
#f)))
- (define (dependency-grafts item)
- (match (reference-origin drv item)
- ((drv . output)
- ;; If GRAFTS already contains a graft from DRV, do not override it.
- (if (find (cut graft-origin? drv <>) grafts)
- (state-return grafts)
- (cumulative-grafts store drv grafts
- #:outputs (list output)
- #:guile guile
- #:system system)))
- (#f
- (state-return grafts))))
+ (define (dependency-grafts items)
+ (mapm %store-monad
+ (lambda (drv+output)
+ (match drv+output
+ ((drv . output)
+ ;; If GRAFTS already contains a graft from DRV, do not
+ ;; override it.
+ (if (find (cut graft-origin? drv <>) grafts)
+ (state-return grafts)
+ (cumulative-grafts store drv grafts
+ #:outputs (list output)
+ #:guile guile
+ #:system system)))))
+ (reference-origins drv items)))
(with-cache (cons (derivation-file-name drv) outputs)
(match (non-self-references store drv outputs)
(() ;no dependencies
(return grafts))
(deps ;one or more dependencies
- (mlet %state-monad ((grafts (mapm %state-monad dependency-grafts deps)))
+ (mlet %state-monad ((grafts (dependency-grafts deps)))
(let ((grafts (delete-duplicates (concatenate grafts) equal?)))
(match (filter (lambda (graft)
(member (graft-origin-file-name graft) deps))
Display info messages
Send a report that this bug log contains spam .
debbugs.gnu.org maintainers
<help-debbugs@gnu.org >.
Last modified:
Sun Dec 22 15:00:39 2024;
Machine Name:
wallace-server
GNU bug tracking system
Debbugs is free software and licensed under the terms of the
GNU Public License version 2. The current version can be
obtained from https://bugs.debian.org/debbugs-source/ .
Copyright © 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson,
2005-2017 Don Armstrong, and many other contributors.