profiles: Compute manual database entries in parallel.

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 <ludo@gnu.org>
This commit is contained in:
Arne Babenhauserheide 2019-07-12 23:42:45 +02:00 committed by Ludovic Courtès
parent 67cbfeae30
commit ef4b5f2fed
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 26 additions and 14 deletions

View File

@ -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"))