nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2013-12-14 16:31:01 +01:00
parent 0c2e1dd45d
commit ca6c4fa190
1 changed files with 47 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
guix/scripts/pull.scm
View File

@ -59,29 +59,49 @@ files."
(gcrypt (assoc-ref %build-inputs "gcrypt")) (gcrypt (assoc-ref %build-inputs "gcrypt"))
(tarball (assoc-ref %build-inputs "tarball"))) (tarball (assoc-ref %build-inputs "tarball")))
(define* (compile-file* file #:key output-file (opts '())) (define (call-with-process thunk)
;; Like 'compile-file', but in a separate process, to work around ;; Run THUNK in a separate process that will return 0 if THUNK
;; <http://bugs.gnu.org/15602> (FIXME). This ensures correctness, ;; terminates normally, and 1 if an exception is raised.
;; 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.
(match (primitive-fork) (match (primitive-fork)
(0 (0
(catch #t (catch #t
(lambda () (lambda ()
(compile-file file (thunk)
#:output-file output-file
#:opts opts)
(primitive-exit 0)) (primitive-exit 0))
(lambda (key . args) (lambda (key . args)
(print-exception (current-error-port) #f key args) (print-exception (current-error-port) #f key args)
(primitive-exit 1)))) (primitive-exit 1))))
(pid (pid
(match (waitpid pid) #t)))
((_ . status)
(unless (zero? (status:exit-val status)) (define (p-for-each proc lst)
(error "failed to compile file" file status))))))) ;; 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")) (setenv "PATH" (string-append tar "/bin:" gzip "/bin"))
@ -113,19 +133,24 @@ files."
(set! %load-path (cons out %load-path)) (set! %load-path (cons out %load-path))
(set! %load-compiled-path (cons out %load-compiled-path)) (set! %load-compiled-path (cons out %load-compiled-path))
;; Compile the .scm files. ;; Compile the .scm files. Do that in independent processes, à la
(for-each (lambda (file) ;; 'make -j', to work around <http://bugs.gnu.org/15602> (FIXME).
(when (string-suffix? ".scm" file) ;; 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) (let ((go (string-append (string-drop-right file 4)
".go"))) ".go")))
(format (current-error-port) (format (current-error-port)
"compiling '~a'...~%" file) "compiling '~a'...~%" file)
(compile-file* file (compile-file file
#:output-file go #:output-file go
#:opts #:opts
%auto-compilation-options)))) %auto-compilation-options)))
(find-files out "\\.scm")) (filter (cut string-suffix? ".scm" <>)
(find-files out "\\.scm")))
;; Remove the "fake" (guix config). ;; Remove the "fake" (guix config).
(delete-file (string-append out "/guix/config.scm")) (delete-file (string-append out "/guix/config.scm"))