From ef4b5f2fed3ca13a0e15a821ba7e561cd4395aa6 Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide Date: Fri, 12 Jul 2019 23:42:45 +0200 Subject: profiles: Compute manual database entries in parallel. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This provides a 36% speedup on an SSD and 4 cores for the 1.5K man pages in the manual database derivation of: guix environment --ad-hoc jupyter python-ipython python-ipykernel * guix/profiles.scm (manual-database)[build]: Add 'print-string', 'print', and 'compute-entry'. Change 'compute-entries' to call 'compute-entry' in 'n-par-map'. Co-authored-by: Ludovic Courtès --- guix/profiles.scm | 40 ++++++++++++++++++++++++++-------------- 1 file changed, 26 insertions(+), 14 deletions(-) (limited to 'guix') diff --git a/guix/profiles.scm b/guix/profiles.scm index 8aa76a3537..47a7c92569 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -1418,26 +1418,38 @@ the entries in MANIFEST." #~(begin (use-modules (guix man-db) (guix build utils) + (ice-9 threads) (srfi srfi-1) (srfi srfi-19)) + (define (print-string msg) + (display msg) + (force-output)) + + (define-syntax-rule (print fmt args ...) + ;; Build up the string and display it at once. + (print-string (format #f fmt args ...))) + + (define (compute-entry directory count total) + (print "\r[~3d/~3d] building list of man-db entries..." + count total) + (let ((man (string-append directory "/share/man"))) + (if (directory-exists? man) + (mandb-entries man) + '()))) + (define (compute-entries) ;; This is the most expensive part (I/O and CPU, due to ;; decompression), so report progress as we traverse INPUTS. - (let* ((inputs '#$(manifest-inputs manifest)) - (total (length inputs))) - (append-map (lambda (directory count) - (format #t "\r[~3d/~3d] building list of \ -man-db entries..." - count total) - (force-output) - (let ((man (string-append directory - "/share/man"))) - (if (directory-exists? man) - (mandb-entries man) - '()))) - inputs - (iota total 1)))) + ;; Cap at 4 threads because we don't see any speedup beyond that + ;; on an SSD laptop. + (let* ((inputs '#$(manifest-inputs manifest)) + (total (length inputs)) + (threads (min (parallel-job-count) 4))) + (concatenate + (n-par-map threads compute-entry inputs + (iota total 1) + (make-list total total))))) (define man-directory (string-append #$output "/share/man")) -- cgit v1.2.3