summaryrefslogtreecommitdiff
path: root/guix/scripts/pull.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-12-14 16:31:01 +0100
committerLudovic Courtès <ludo@gnu.org>2013-12-14 16:32:42 +0100
commitca6c4fa190e95efba7ade83a0decb19de084f4f5 (patch)
treed5f5497fefd398cec479414582e620d4ea0e1354 /guix/scripts/pull.scm
parent0c2e1dd45d5da2c23b3cc11a1903d01f7027da1c (diff)
pull: Compile files in parallel.
* guix/scripts/pull.scm (unpack)[builder](compile-file*): Remove. (call-with-process, p-for-each): New procedures. Use them to compile files in parallel.
Diffstat (limited to 'guix/scripts/pull.scm')
-rw-r--r--guix/scripts/pull.scm69
1 files changed, 47 insertions, 22 deletions
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 23f20493d1..e56897986a 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -59,29 +59,49 @@ files."
(gcrypt (assoc-ref %build-inputs "gcrypt"))
(tarball (assoc-ref %build-inputs "tarball")))
- (define* (compile-file* file #:key output-file (opts '()))
- ;; Like 'compile-file', but in a separate process, to work around
- ;; <http://bugs.gnu.org/15602> (FIXME). This ensures correctness,
- ;; but is overly conservative and very slow. The solution
- ;; initially implemented (and described in the bug above) was
- ;; slightly faster but consumed memory proportional to the number
- ;; of modules, which quickly became unacceptable.
+ (define (call-with-process thunk)
+ ;; Run THUNK in a separate process that will return 0 if THUNK
+ ;; terminates normally, and 1 if an exception is raised.
(match (primitive-fork)
(0
(catch #t
(lambda ()
- (compile-file file
- #:output-file output-file
- #:opts opts)
+ (thunk)
(primitive-exit 0))
(lambda (key . args)
(print-exception (current-error-port) #f key args)
(primitive-exit 1))))
(pid
- (match (waitpid pid)
- ((_ . status)
- (unless (zero? (status:exit-val status))
- (error "failed to compile file" file status)))))))
+ #t)))
+
+ (define (p-for-each proc lst)
+ ;; Invoke PROC for each element of LST in a separate process.
+ ;; Raise an error if one of the processes exit with non-zero.
+ (define (wait-for-one-process)
+ (match (waitpid WAIT_ANY)
+ ((_ . status)
+ (unless (zero? (status:exit-val status))
+ (error "process failed" proc status)))))
+
+ (define max-processes
+ (current-processor-count))
+
+ (let loop ((lst lst)
+ (running 0))
+ (match lst
+ (()
+ (or (zero? running)
+ (begin
+ (wait-for-one-process)
+ (loop lst (- running 1)))))
+ ((head . tail)
+ (if (< running max-processes)
+ (begin
+ (call-with-process (cut proc head))
+ (loop tail (+ running 1)))
+ (begin
+ (wait-for-one-process)
+ (loop lst (- running 1))))))))
(setenv "PATH" (string-append tar "/bin:" gzip "/bin"))
@@ -113,19 +133,24 @@ files."
(set! %load-path (cons out %load-path))
(set! %load-compiled-path (cons out %load-compiled-path))
- ;; Compile the .scm files.
- (for-each (lambda (file)
- (when (string-suffix? ".scm" file)
+ ;; Compile the .scm files. Do that in independent processes, à la
+ ;; 'make -j', to work around <http://bugs.gnu.org/15602> (FIXME).
+ ;; This ensures correctness, but is overly conservative and slow.
+ ;; The solution initially implemented (and described in the bug
+ ;; above) was slightly faster but consumed memory proportional to the
+ ;; number of modules, which quickly became unacceptable.
+ (p-for-each (lambda (file)
(let ((go (string-append (string-drop-right file 4)
".go")))
(format (current-error-port)
"compiling '~a'...~%" file)
- (compile-file* file
- #:output-file go
- #:opts
- %auto-compilation-options))))
+ (compile-file file
+ #:output-file go
+ #:opts
+ %auto-compilation-options)))
- (find-files out "\\.scm"))
+ (filter (cut string-suffix? ".scm" <>)
+ (find-files out "\\.scm")))
;; Remove the "fake" (guix config).
(delete-file (string-append out "/guix/config.scm"))