diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-12-14 16:31:01 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-12-14 16:32:42 +0100 |
commit | ca6c4fa190e95efba7ade83a0decb19de084f4f5 (patch) | |
tree | d5f5497fefd398cec479414582e620d4ea0e1354 | |
parent | 0c2e1dd45d5da2c23b3cc11a1903d01f7027da1c (diff) | |
download | guix-ca6c4fa190e95efba7ade83a0decb19de084f4f5.tar guix-ca6c4fa190e95efba7ade83a0decb19de084f4f5.tar.gz |
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.
-rw-r--r-- | guix/scripts/pull.scm | 69 |
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")) |